diff --git a/jscomp/core/j.ml b/jscomp/core/j.ml index 084f3e90af..09152f87e3 100644 --- a/jscomp/core/j.ml +++ b/jscomp/core/j.ml @@ -61,7 +61,6 @@ type property_name = Js_op.property_name type label = string -and required_modules = module_id list and ident = Ident.t (* we override `method ident` *) @@ -74,6 +73,7 @@ and ident = Ident.t (* we override `method ident` *) and module_id = { id : ident; kind : Js_op.kind } +and required_modules = module_id list and vident = | Id of ident | Qualified of module_id * string option @@ -273,7 +273,14 @@ and finish_ident_expression = expression (* pure *) } ]} *) +and case_clause = { + switch_body : block ; + should_break : bool ; (* true means break *) + comment : string option ; +} +and string_clause = string * case_clause +and int_clause = int * case_clause and statement_desc = | Block of block @@ -325,13 +332,6 @@ and variable_declaration = { property : property; ident_info : ident_info; } -and string_clause = string * case_clause -and int_clause = int * case_clause -and case_clause = { - switch_body : block ; - should_break : bool ; (* true means break *) - comment : string option ; -} (* TODO: For efficency: block should not be a list, it should be able to be concatenated in both ways @@ -350,4 +350,26 @@ and deps_program = modules : required_modules ; side_effect : string option (* None: no, Some reason *) } - [@@deriving] \ No newline at end of file +[@@deriving {excludes = [| + deps_program ; + int_clause; + string_clause ; + for_direction; + (* exception_ident; *) + for_direction; + expression_desc; + statement_desc; + for_ident_expression; + label; + finish_ident_expression; + property_map; + length_object; + (* for_ident; *) + required_modules; + case_clause + |] }] +(* +FIXME: customize for each code generator +for each code generator, we can provide a white-list +so that we can achieve the optimal +*) \ No newline at end of file diff --git a/jscomp/core/js_fold.ml b/jscomp/core/js_fold.ml index ba7fe419b6..65889fe769 100644 --- a/jscomp/core/js_fold.ml +++ b/jscomp/core/js_fold.ml @@ -20,9 +20,9 @@ | [] -> _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 = 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 required_modules : required_modules -> 'self_type = list (fun _self -> _self#module_id) _self method vident : vident -> 'self_type = function | Id ( _x0) -> let _self = _self#ident _x0 in @@ -127,6 +127,9 @@ let _self = _self#property_map _x0 in |Null -> _self method for_ident_expression : for_ident_expression -> 'self_type = _self#expression method finish_ident_expression : finish_ident_expression -> 'self_type = _self#expression +method case_clause : case_clause -> 'self_type = fun { switch_body = _x0;should_break = _x1;comment = _x2} -> let _self = _self#block _x0 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 statement_desc : statement_desc -> 'self_type = function | Block ( _x0) -> let _self = _self#block _x0 in @@ -184,9 +187,6 @@ method expression : expression -> 'self_type = fun { expression_desc = _x0;comme 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 (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 = 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 diff --git a/jscomp/core/js_iter.ml b/jscomp/core/js_iter.ml deleted file mode 100644 index c07e912b9b..0000000000 --- a/jscomp/core/js_iter.ml +++ /dev/null @@ -1,120 +0,0 @@ - - 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 - \ No newline at end of file diff --git a/jscomp/core/js_map.ml b/jscomp/core/js_map.ml deleted file mode 100644 index d938c36377..0000000000 --- a/jscomp/core/js_map.ml +++ /dev/null @@ -1,191 +0,0 @@ - -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 -| Id ( _x0) -> -let _x0 = _self#ident _x0 in -Id ( _x0) -|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 -| Length ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#length_object _x1 in -Length ( _x0,_x1) -|Char_of_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_of_int ( _x0) -|Char_to_int ( _x0) -> -let _x0 = _self#expression _x0 in -Char_to_int ( _x0) -|Is_null_or_undefined ( _x0) -> -let _x0 = _self#expression _x0 in -Is_null_or_undefined ( _x0) -|String_append ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_append ( _x0,_x1) -|Bool _ as v -> v -|Typeof ( _x0) -> -let _x0 = _self#expression _x0 in -Typeof ( _x0) -|Js_not ( _x0) -> -let _x0 = _self#expression _x0 in -Js_not ( _x0) -|Seq ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Seq ( _x0,_x1) -|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) -|Bin ( _x0,_x1,_x2) -> -let _x1 = _self#expression _x1 in -let _x2 = _self#expression _x2 in -Bin ( _x0,_x1,_x2) -|FlatCall ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -FlatCall ( _x0,_x1) -|Call ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -let _x1 = list (_self#expression) _x1 in -Call ( _x0,_x1,_x2) -|String_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -String_index ( _x0,_x1) -|Array_index ( _x0,_x1) -> -let _x0 = _self#expression _x0 in -let _x1 = _self#expression _x1 in -Array_index ( _x0,_x1) -|Static_index ( _x0,_x1,_x2) -> -let _x0 = _self#expression _x0 in -Static_index ( _x0,_x1,_x2) -|New ( _x0,_x1) -> -let _x0 = _self#expression _x0 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 = 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 = 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 = list (_self#expression) _x0 in -let _x2 = _self#expression _x2 in -Caml_block ( _x0,_x1,_x2,_x3) -|Caml_block_tag ( _x0) -> -let _x0 = _self#expression _x0 in -Caml_block_tag ( _x0) -|Number _ as v -> v -|Object ( _x0) -> -let _x0 = _self#property_map _x0 in -Object ( _x0) -|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 -| Block ( _x0) -> -let _x0 = _self#block _x0 in -Block ( _x0) -|Variable ( _x0) -> -let _x0 = _self#variable_declaration _x0 in -Variable ( _x0) -|Exp ( _x0) -> -let _x0 = _self#expression _x0 in -Exp ( _x0) -|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) -|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) -|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) -|Continue ( _x0) -> -let _x0 = _self#label _x0 in -Continue ( _x0) -|Break as v -> v -|Return ( _x0) -> -let _x0 = _self#expression _x0 in -Return ( _x0) -|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) -|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) -|Throw ( _x0) -> -let _x0 = _self#expression _x0 in -Throw ( _x0) -|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 diff --git a/jscomp/core/js_pass_scope.ml b/jscomp/core/js_pass_scope.ml index f825f5e464..5e013c731d 100644 --- a/jscomp/core/js_pass_scope.ml +++ b/jscomp/core/js_pass_scope.ml @@ -99,118 +99,100 @@ done ]} *) - -let scope_pass = - object(self) - inherit Js_fold.fold as super - - val defined_idents = Set_ident.empty - - (** [used_idents] - does not contain locally defined idents *) - val used_idents = Set_ident.empty - (** we need collect mutable values and loop defined varaibles *) - val loop_mutable_values = Set_ident.empty - - val mutable_values = Set_ident.empty - - val closured_idents = Set_ident.empty - - (** check if in loop or not *) - val in_loop = false - - method get_in_loop = in_loop - - method get_defined_idents = defined_idents - - method get_used_idents = used_idents - - method get_loop_mutable_values = loop_mutable_values - - method get_mutable_values = mutable_values - - method get_closured_idents = closured_idents - - method with_in_loop b = - if b = self#get_in_loop then self - else {< in_loop = b >} - (* Since it's loop mutable variable, for sure - it is mutable variable - *) - method with_loop_mutable_values b = - {< loop_mutable_values = b >} - - method add_loop_mutable_variable id = - {< loop_mutable_values = Set_ident.add loop_mutable_values id; - mutable_values = Set_ident.add mutable_values id - >} - - method add_mutable_variable id = - {< mutable_values = Set_ident.add mutable_values id >} - - method add_defined_ident ident = - {< defined_idents = Set_ident.add defined_idents ident >} - method add_used_ident ident = - {< used_idents = Set_ident.add used_idents ident >} - method! expression x = - match x.expression_desc with - | Fun (_method_, params, block , env) -> - (* Function is the only place to introduce a new scope in - ES5 - TODO: check - {[ try .. catch(exn) {.. }]} - what's the scope of exn - *) - (* Note that [used_idents] is not complete - it ignores some locally defined idents *) - let param_set = Set_ident.of_list params in - let obj = {} # block block in - let defined_idents', used_idents' = - obj#get_defined_idents, obj#get_used_idents in - (* mark which param is used *) - params |> List.iteri - (fun i v -> - if not (Set_ident.mem used_idents' v) then - Js_fun_env.mark_unused env i) ; - let closured_idents' = (* pass param_set down *) - Set_ident.(diff used_idents' (union defined_idents' param_set )) in - - (* Noe that we don't know which variables are exactly mutable yet .. - due to the recursive thing - *) - Js_fun_env.set_unbounded env closured_idents' ; - let lexical_scopes = Set_ident.(inter closured_idents' self#get_loop_mutable_values) in - Js_fun_env.set_lexical_scope env lexical_scopes; - (* tailcall , note that these varibles are used in another pass *) - {< used_idents = - Set_ident.union used_idents closured_idents' ; - (* There is a bug in ocaml -dsource*) - closured_idents = Set_ident.union closured_idents closured_idents' - >} - | _ -> - let obj = super#expression x in - match Js_block_runtime.check_additional_id x with - | None -> obj - | Some id -> - obj#add_used_ident id - (* TODO: most variables are immutable *) - - method! variable_declaration x = +type state = { + defined_idents : Set_ident.t; + used_idents : Set_ident.t; + loop_mutable_values : Set_ident.t; + mutable_values : Set_ident.t; + closured_idents : Set_ident.t; + in_loop : bool; +} + +let init_state = { + defined_idents = Set_ident.empty; + used_idents = Set_ident.empty; + loop_mutable_values = Set_ident.empty; + mutable_values = Set_ident.empty; + closured_idents = Set_ident.empty; + in_loop = false; +} +let with_in_loop (st:state) b = + if b = st.in_loop then st + else {st with in_loop = b} +let add_loop_mutable_variable (st : state) id = + { st with + loop_mutable_values = Set_ident.add st.loop_mutable_values id; + mutable_values = Set_ident.add st.mutable_values id + } +let add_mutable_variable (st: state) id = + { + st with + mutable_values = Set_ident.add st.mutable_values id + } +let add_defined_ident (st : state) id = { + st with + defined_idents = Set_ident.add st.defined_idents id +} +let add_used_ident (st : state) id = { + st with used_idents = Set_ident.add st.used_idents id +} + + +let super = Js_record_fold.super +let record_scope_pass = { + super with + expression = begin fun self state x -> + match x.expression_desc with + | Fun (_method_, params, block , env) -> + (* Function is the only place to introduce a new scope in + ES5 + TODO: check + {[ try .. catch(exn) {.. }]} + what's the scope of exn + *) + (* Note that [used_idents] is not complete + it ignores some locally defined idents *) + let param_set = Set_ident.of_list params in + let {defined_idents = defined_idents' ; used_idents = used_idents' } = self.block self { + init_state with + mutable_values = Set_ident.of_list (Js_fun_env.get_mutable_params params env) ; + } block in + (* let defined_idents', used_idents' = + obj#get_defined_idents, obj#get_used_idents in *) + (* mark which param is used *) + params |> List.iteri + (fun i v -> + if not (Set_ident.mem used_idents' v) then + Js_fun_env.mark_unused env i) ; + let closured_idents' = (* pass param_set down *) + Set_ident.(diff used_idents' (union defined_idents' param_set )) in + + (* Noe that we don't know which variables are exactly mutable yet .. + due to the recursive thing + *) + Js_fun_env.set_unbounded env closured_idents' ; + let lexical_scopes = Set_ident.(inter closured_idents' state.loop_mutable_values) in + Js_fun_env.set_lexical_scope env lexical_scopes; + (* tailcall , note that these varibles are used in another pass *) + {state with used_idents = + Set_ident.union state.used_idents closured_idents' ; + (* There is a bug in ocaml -dsource*) + closured_idents = Set_ident.union state.closured_idents closured_idents' + } + | _ -> + let obj = super.expression self state x in + match Js_block_runtime.check_additional_id x with + | None -> obj + | Some id -> add_used_ident obj id + end; + variable_declaration = begin fun self state x -> match x with | { ident ; value; property } -> let obj = - (match self#get_in_loop, property with + add_defined_ident (match state.in_loop, property with | true, Variable -> - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident | true, (Strict | StrictOpt | Alias) (* Not real true immutable in javascript since it's in the loop @@ -219,7 +201,7 @@ let scope_pass = *) -> begin match value with - | None -> self#add_loop_mutable_variable ident + | None -> add_loop_mutable_variable state ident (* TODO: Check why assertion failure *) (* self#add_loop_mutable_variable ident *) (* assert false *) | Some x @@ -234,7 +216,7 @@ let scope_pass = *) match x.expression_desc with | Fun _ | Number _ | Str _ - -> self + -> state | _ -> (* if Set_ident.(is_empty @@ *) (* inter self#get_mutable_values *) @@ -245,80 +227,87 @@ let scope_pass = (* (\* FIXME: still need to check expression is pure or not*\) *) (* self *) (* else *) - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident end | false, Variable -> - self#add_mutable_variable ident + add_mutable_variable state ident | false, (Strict | StrictOpt | Alias) - -> self - )#add_defined_ident ident + -> state + ) ident in begin match value with | None -> obj - | Some x -> obj # expression x + | Some x -> self.expression self obj x end - - - method! statement x = + end; + statement = begin fun self state x -> match x.statement_desc with - | ForRange (_,_, loop_id, _,_,a_env) as y -> (* TODO: simplify definition of For *) - let obj = - {< in_loop = true ; - loop_mutable_values = Set_ident.singleton loop_id ; - used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) - defined_idents = Set_ident.singleton loop_id ; - closured_idents = Set_ident.empty (* Think about nested for blocks *) - (* Invariant: Finish id is never used *) - >} - # statement_desc y in + | ForRange (_,_, loop_id, _,_,a_env) -> (* TODO: simplify definition of For *) + let {defined_idents = defined_idents'; used_idents = used_idents'; closured_idents = closured_idents'} = - let defined_idents', used_idents', closured_idents' = - obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in + super.statement self { in_loop = true ; + loop_mutable_values = Set_ident.singleton loop_id ; + used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) + defined_idents = Set_ident.singleton loop_id ; + closured_idents = Set_ident.empty ;(* Think about nested for blocks *) + (* Invariant: Finish id is never used *) + mutable_values = state.mutable_values + } x in (* CHECK*) + (* let defined_idents', used_idents', closured_idents' = + obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in *) - let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') self#get_loop_mutable_values) in + + let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') state.loop_mutable_values) in let () = Js_closure.set_lexical_scope a_env lexical_scope in (* set scope *) - {< used_idents = Set_ident.union used_idents used_idents'; + { state with + used_idents = Set_ident.union state.used_idents used_idents'; (* walk around ocaml -dsource bug {[ Set_ident.(union used_idents used_idents) ]} *) - defined_idents = Set_ident.union defined_idents defined_idents'; + defined_idents = Set_ident.union state.defined_idents defined_idents'; (* TODO: if we our generated code also follow lexical scope, this is not necessary ; [varaibles] are mutable or not is known at definition *) - closured_idents = Set_ident.union closured_idents lexical_scope - >} + closured_idents = Set_ident.union state.closured_idents lexical_scope + } | While (_label,pred,body, _env) -> - (((self#expression pred)#with_in_loop true) # block body ) - #with_in_loop (self#get_in_loop) + with_in_loop (self.block self (with_in_loop (self.expression self state pred) true) body ) + (state.in_loop) | _ -> - super#statement x - - method! exception_ident x = - (* we can not simply skip it, since it can be used - TODO: check loop exception - (loop { - excption(i){ - () => {i} - } - }) - *) - {< used_idents = Set_ident.add used_idents x ; - defined_idents = Set_ident.add defined_idents x - >} - method! for_ident x = {< loop_mutable_values = Set_ident.add loop_mutable_values x >} + super.statement self state x + end; + + + exception_ident = begin fun _ state x -> + (* we can not simply skip it, since it can be used + TODO: check loop exception + (loop { + excption(i){ + () => {i} + } + }) + *) + {state with used_idents = Set_ident.add state.used_idents x ; + defined_idents = Set_ident.add state.defined_idents x + } + end; + for_ident = begin fun _ state x -> {state with loop_mutable_values = Set_ident.add state.loop_mutable_values x } end; + + ident = begin fun _ state x -> + if Set_ident.mem state.defined_idents x then + state + else {state with used_idents = Set_ident.add state.used_idents x } + end +} - method! ident x = - if Set_ident.mem defined_idents x then - self - else {< used_idents = Set_ident.add used_idents x >} - end let program js = - (scope_pass # program js ) # get_loop_mutable_values + (record_scope_pass.program record_scope_pass init_state js).loop_mutable_values + (* (scope_pass # program js ) # get_loop_mutable_values *) diff --git a/jscomp/core/js_record_fold.ml b/jscomp/core/js_record_fold.ml new file mode 100644 index 0000000000..3016e0dba8 --- /dev/null +++ b/jscomp/core/js_record_fold.ml @@ -0,0 +1,146 @@ + +open J +let [@inline] unknown _ st _ = st +let [@inline] option sub self st = fun v -> + match v with + | None -> st + | Some v -> sub self st v +let rec list sub self st = fun x -> + match x with + | [] -> st + | x::xs -> + let st = sub self st x in + list sub self st xs + +type 'state iter = { + ident : ('state,ident) fn; + module_id : ('state,module_id) fn; + vident : ('state,vident) fn; + exception_ident : ('state,exception_ident) fn; + for_ident : ('state,for_ident) fn; + expression : ('state,expression) fn; + statement : ('state,statement) fn; + variable_declaration : ('state,variable_declaration) fn; + block : ('state,block) fn; + program : ('state,program) fn +} +and ('state,'a) fn = 'state iter -> 'state -> 'a -> 'state +let label : 'a . ('a,label) fn = unknown +let ident : 'a . ('a,ident) fn = unknown +let module_id : 'a . ('a,module_id) fn = fun _self st { id = _x0;kind = _x1} -> let st = _self.ident _self st _x0 in st +let required_modules : 'a . ('a,required_modules) fn = fun _self st arg -> list _self.module_id _self st arg +let vident : 'a . ('a,vident) fn = fun _self st -> function +| Id ( _x0) -> + let st = _self.ident _self st _x0 in st +|Qualified ( _x0,_x1) -> + let st = _self.module_id _self st _x0 in st +let exception_ident : 'a . ('a,exception_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_ident : 'a . ('a,for_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_direction : 'a . ('a,for_direction) fn = unknown +let property_map : 'a . ('a,property_map) fn = fun _self st arg -> list ((fun _self st (_x0,_x1) -> let st = _self.expression _self st _x1 in st )) _self st arg +let length_object : 'a . ('a,length_object) fn = unknown +let expression_desc : 'a . ('a,expression_desc) fn = fun _self st -> function +| Length ( _x0,_x1) -> + let st = _self.expression _self st _x0 in let st = length_object _self st _x1 in st +|Char_of_int ( _x0) -> + let st = _self.expression _self st _x0 in st +|Char_to_int ( _x0) -> + let st = _self.expression _self st _x0 in st +|Is_null_or_undefined ( _x0) -> + let st = _self.expression _self st _x0 in st +|String_append ( _x0,_x1) -> + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Bool _ -> st +|Typeof ( _x0) -> + let st = _self.expression _self st _x0 in st +|Js_not ( _x0) -> + let st = _self.expression _self st _x0 in st +|Seq ( _x0,_x1) -> + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Cond ( _x0,_x1,_x2) -> + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st +|Bin ( _x0,_x1,_x2) -> + let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st +|FlatCall ( _x0,_x1) -> + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Call ( _x0,_x1,_x2) -> + let st = _self.expression _self st _x0 in let st = list _self.expression _self st _x1 in st +|String_index ( _x0,_x1) -> + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Array_index ( _x0,_x1) -> + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Static_index ( _x0,_x1,_x2) -> + let st = _self.expression _self st _x0 in st +|New ( _x0,_x1) -> + let st = _self.expression _self st _x0 in let st = option (fun _self st arg -> list _self.expression _self st arg) _self st _x1 in st +|Var ( _x0) -> + let st = _self.vident _self st _x0 in st +|Fun ( _x0,_x1,_x2,_x3) -> + let st = list _self.ident _self st _x1 in let st = _self.block _self st _x2 in st +|Str _ -> st +|Unicode _ -> st +|Raw_js_code _ -> st +|Array ( _x0,_x1) -> + let st = list _self.expression _self st _x0 in st +|Optional_block ( _x0,_x1) -> + let st = _self.expression _self st _x0 in st +|Caml_block ( _x0,_x1,_x2,_x3) -> + let st = list _self.expression _self st _x0 in let st = _self.expression _self st _x2 in st +|Caml_block_tag ( _x0) -> + let st = _self.expression _self st _x0 in st +|Number _ -> st +|Object ( _x0) -> + let st = property_map _self st _x0 in st +|Undefined -> st +|Null -> st +let for_ident_expression : 'a . ('a,for_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : 'a . ('a,finish_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let case_clause : 'a . ('a,case_clause) fn = fun _self st { switch_body = _x0;should_break = _x1;comment = _x2} -> let st = _self.block _self st _x0 in st +let string_clause : 'a . ('a,string_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let int_clause : 'a . ('a,int_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let statement_desc : 'a . ('a,statement_desc) fn = fun _self st -> function +| Block ( _x0) -> + let st = _self.block _self st _x0 in st +|Variable ( _x0) -> + let st = _self.variable_declaration _self st _x0 in st +|Exp ( _x0) -> + let st = _self.expression _self st _x0 in st +|If ( _x0,_x1,_x2) -> + let st = _self.expression _self st _x0 in let st = _self.block _self st _x1 in let st = _self.block _self st _x2 in st +|While ( _x0,_x1,_x2,_x3) -> + let st = option label _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.block _self st _x2 in st +|ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> + let st = option for_ident_expression _self st _x0 in let st = finish_ident_expression _self st _x1 in let st = _self.for_ident _self st _x2 in let st = for_direction _self st _x3 in let st = _self.block _self st _x4 in st +|Continue ( _x0) -> + let st = label _self st _x0 in st +|Break -> st +|Return ( _x0) -> + let st = _self.expression _self st _x0 in st +|Int_switch ( _x0,_x1,_x2) -> + let st = _self.expression _self st _x0 in let st = list int_clause _self st _x1 in let st = option _self.block _self st _x2 in st +|String_switch ( _x0,_x1,_x2) -> + let st = _self.expression _self st _x0 in let st = list string_clause _self st _x1 in let st = option _self.block _self st _x2 in st +|Throw ( _x0) -> + let st = _self.expression _self st _x0 in st +|Try ( _x0,_x1,_x2) -> + let st = _self.block _self st _x0 in let st = option ((fun _self st (_x0,_x1) -> let st = _self.exception_ident _self st _x0 in let st = _self.block _self st _x1 in st )) _self st _x1 in let st = option _self.block _self st _x2 in st +|Debugger -> st +let expression : 'a . ('a,expression) fn = fun _self st { expression_desc = _x0;comment = _x1} -> let st = expression_desc _self st _x0 in st +let statement : 'a . ('a,statement) fn = fun _self st { statement_desc = _x0;comment = _x1} -> let st = statement_desc _self st _x0 in st +let variable_declaration : 'a . ('a,variable_declaration) fn = fun _self st { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let st = _self.ident _self st _x0 in let st = option _self.expression _self st _x1 in st +let block : 'a . ('a,block) fn = fun _self st arg -> list _self.statement _self st arg +let program : 'a . ('a,program) fn = fun _self st { block = _x0;exports = _x1;export_set = _x2} -> let st = _self.block _self st _x0 in st +let deps_program : 'a . ('a,deps_program) fn = fun _self st { program = _x0;modules = _x1;side_effect = _x2} -> let st = _self.program _self st _x0 in let st = required_modules _self st _x1 in st +let super : 'state iter = { + ident; + module_id; + vident; + exception_ident; + for_ident; + expression; + statement; + variable_declaration; + block; + program +} + \ No newline at end of file diff --git a/jscomp/core/js_record_iter.ml b/jscomp/core/js_record_iter.ml index 21bb1cdf9b..cb1137074f 100644 --- a/jscomp/core/js_record_iter.ml +++ b/jscomp/core/js_record_iter.ml @@ -1,61 +1,47 @@ - open J - let unknown _ _ = () - let [@inline] 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 +open J +let unknown _ _ = () +let [@inline] 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; +type iter = { 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 super : iter = { - label : label fn = ( unknown ) ; - required_modules : required_modules fn = ( fun _self arg -> list _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> unit +let label : label fn = unknown +let ident : ident fn = unknown +let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end +let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg +let 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 + begin _self.module_id _self _x0 end +let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) +let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) +let for_direction : for_direction fn = unknown +let property_map : property_map fn = fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg +let length_object : length_object fn = unknown +let expression_desc : expression_desc fn = fun _self -> function | Length ( _x0,_x1) -> - begin _self.expression _self _x0;_self.length_object _self _x1 end + begin _self.expression _self _x0;length_object _self _x1 end |Char_of_int ( _x0) -> begin _self.expression _self _x0 end |Char_to_int ( _x0) -> @@ -104,12 +90,15 @@ deps_program : deps_program fn begin _self.expression _self _x0 end |Number _ -> () |Object ( _x0) -> - begin _self.property_map _self _x0 end + begin 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 +|Null -> () +let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let case_clause : case_clause fn = fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end +let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin _self.block _self _x0 end |Variable ( _x0) -> @@ -119,31 +108,39 @@ deps_program : deps_program fn |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 _self.label _self _x0;_self.expression _self _x1;_self.block _self _x2 end + begin option label _self _x0;_self.expression _self _x1;_self.block _self _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option _self.for_ident_expression _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end + begin option for_ident_expression _self _x0;finish_ident_expression _self _x1;_self.for_ident _self _x2;for_direction _self _x3;_self.block _self _x4 end |Continue ( _x0) -> - begin _self.label _self _x0 end + begin label _self _x0 end |Break -> () |Return ( _x0) -> begin _self.expression _self _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.int_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list int_clause _self _x1;option _self.block _self _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.string_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list string_clause _self _x1;option _self.block _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 _self.block _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 _self.expression _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 _self.statement _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 ) +|Debugger -> () +let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin expression_desc _self _x0 end +let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin statement_desc _self _x0 end +let variable_declaration : variable_declaration fn = fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option _self.expression _self _x1 end +let block : block fn = fun _self arg -> list _self.statement _self arg +let program : program fn = fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end +let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;required_modules _self _x1 end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program } \ No newline at end of file diff --git a/jscomp/core/js_record_map.ml b/jscomp/core/js_record_map.ml index 9f18a7d1d5..747a97bd8f 100644 --- a/jscomp/core/js_record_map.ml +++ b/jscomp/core/js_record_map.ml @@ -1,62 +1,48 @@ - open J - let [@inline] unknown _ x = x - let [@inline] 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 +open J +let [@inline] unknown _ x = x +let [@inline] 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; +type iter = { 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 _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> 'a + let label : label fn = unknown + let ident : ident fn = unknown + let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end + let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg + let 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 + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end + let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) + let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) + let for_direction : for_direction fn = unknown + let 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 + let length_object : length_object fn = unknown + let 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 +let _x1 = 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) -> @@ -117,12 +103,15 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 + begin let _x0 = 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 +|Null as v -> v + let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let 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 + let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin let _x0 = _self.block _self _x0 in Block ( _x0) end |Variable ( _x0) -> @@ -134,27 +123,27 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 _self.label _self _x0 in + begin let _x0 = option label _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 _self.for_ident_expression _self _x0 in -let _x1 = _self.finish_ident_expression _self _x1 in + begin let _x0 = option for_ident_expression _self _x0 in +let _x1 = finish_ident_expression _self _x1 in let _x2 = _self.for_ident _self _x2 in -let _x3 = _self.for_direction _self _x3 in +let _x3 = 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 + begin let _x0 = 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 _self.int_clause _self _x1 in +let _x1 = list int_clause _self _x1 in let _x2 = option _self.block _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 _self.string_clause _self _x1 in +let _x1 = list string_clause _self _x1 in let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_x2) end |Throw ( _x0) -> begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end @@ -162,17 +151,24 @@ let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_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 _self.block _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 _self.expression _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 _self.statement _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 +|Debugger as v -> v + let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end + let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end + let 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 _self.expression _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end + let block : block fn = fun _self arg -> list _self.statement _self arg + let 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 + let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program +} diff --git a/jscomp/ext/ext_pervasives.mli b/jscomp/ext/ext_pervasives.mli index 72a11e4370..e445dc4ab8 100644 --- a/jscomp/ext/ext_pervasives.mli +++ b/jscomp/ext/ext_pervasives.mli @@ -36,7 +36,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) diff --git a/jscomp/ounit/oUnit.ml b/jscomp/ounit/oUnit.ml index ef5aa40130..c9deb26d7e 100644 --- a/jscomp/ounit/oUnit.ml +++ b/jscomp/ounit/oUnit.ml @@ -262,7 +262,7 @@ let assert_command let raises f = try - f (); + ignore (f ()); None with e -> Some e @@ -462,7 +462,7 @@ let maybe_backtrace = "" let perform_test report test = let run_test_case f path = try - f (); + ignore(f ()); RSuccess path with | Failure s -> @@ -496,11 +496,11 @@ let perform_test report test = let test_cases = List.rev (flatten_test [] [] test) in let runner (path, f) = let result = - report (EStart path); + ignore @@ report (EStart path); run_test_case f path in - report (EResult result); - report (EEnd path); + ignore @@ report (EResult result); + ignore @@ report (EEnd path); result in let rec iter state = diff --git a/lib/4.06.1/bsb.ml b/lib/4.06.1/bsb.ml index d67c804440..d3816a66bb 100644 --- a/lib/4.06.1/bsb.ml +++ b/lib/4.06.1/bsb.ml @@ -4993,7 +4993,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) diff --git a/lib/4.06.1/bsb_helper.ml b/lib/4.06.1/bsb_helper.ml index f817a5c9dd..97a1d77b0f 100644 --- a/lib/4.06.1/bsb_helper.ml +++ b/lib/4.06.1/bsb_helper.ml @@ -38,7 +38,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) diff --git a/lib/4.06.1/unstable/all_ounit_tests.ml b/lib/4.06.1/unstable/all_ounit_tests.ml index 0ae52245ea..2e3e0b94a5 100644 --- a/lib/4.06.1/unstable/all_ounit_tests.ml +++ b/lib/4.06.1/unstable/all_ounit_tests.ml @@ -888,7 +888,7 @@ let assert_command let raises f = try - f (); + ignore (f ()); None with e -> Some e @@ -1088,7 +1088,7 @@ let maybe_backtrace = "" let perform_test report test = let run_test_case f path = try - f (); + ignore(f ()); RSuccess path with | Failure s -> @@ -1122,11 +1122,11 @@ let perform_test report test = let test_cases = List.rev (flatten_test [] [] test) in let runner (path, f) = let result = - report (EStart path); + ignore @@ report (EStart path); run_test_case f path in - report (EResult result); - report (EEnd path); + ignore @@ report (EResult result); + ignore @@ report (EEnd path); result in let rec iter state = @@ -5641,7 +5641,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) diff --git a/lib/4.06.1/unstable/bspack.ml b/lib/4.06.1/unstable/bspack.ml index 70813b78a3..deadd3ffab 100644 --- a/lib/4.06.1/unstable/bspack.ml +++ b/lib/4.06.1/unstable/bspack.ml @@ -10553,7 +10553,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 85cf3d3245..4cd662293e 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -81801,7 +81801,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) @@ -85816,7 +85816,6 @@ type property_name = Js_op.property_name type label = string -and required_modules = module_id list and ident = Ident.t (* we override `method ident` *) @@ -85829,6 +85828,7 @@ and ident = Ident.t (* we override `method ident` *) and module_id = { id : ident; kind : Js_op.kind } +and required_modules = module_id list and vident = | Id of ident | Qualified of module_id * string option @@ -86028,7 +86028,14 @@ and finish_ident_expression = expression (* pure *) } ]} *) +and case_clause = { + switch_body : block ; + should_break : bool ; (* true means break *) + comment : string option ; +} +and string_clause = string * case_clause +and int_clause = int * case_clause and statement_desc = | Block of block @@ -86080,13 +86087,6 @@ and variable_declaration = { property : property; ident_info : ident_info; } -and string_clause = string * case_clause -and int_clause = int * case_clause -and case_clause = { - switch_body : block ; - should_break : bool ; (* true means break *) - comment : string option ; -} (* TODO: For efficency: block should not be a list, it should be able to be concatenated in both ways @@ -86105,7 +86105,29 @@ and deps_program = modules : required_modules ; side_effect : string option (* None: no, Some reason *) } - [@@deriving] +[@@deriving {excludes = [| + deps_program ; + int_clause; + string_clause ; + for_direction; + (* exception_ident; *) + for_direction; + expression_desc; + statement_desc; + for_ident_expression; + label; + finish_ident_expression; + property_map; + length_object; + (* for_ident; *) + required_modules; + case_clause + |] }] +(* +FIXME: customize for each code generator +for each code generator, we can provide a white-list +so that we can achieve the optimal +*) end module Js_dump_lit = struct @@ -86708,63 +86730,49 @@ module Js_record_iter = struct #1 "js_record_iter.ml" - open J - let unknown _ _ = () - let [@inline] 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 +open J +let unknown _ _ = () +let [@inline] 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; +type iter = { 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 super : iter = { - label : label fn = ( unknown ) ; - required_modules : required_modules fn = ( fun _self arg -> list _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> unit +let label : label fn = unknown +let ident : ident fn = unknown +let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end +let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg +let 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 + begin _self.module_id _self _x0 end +let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) +let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) +let for_direction : for_direction fn = unknown +let property_map : property_map fn = fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg +let length_object : length_object fn = unknown +let expression_desc : expression_desc fn = fun _self -> function | Length ( _x0,_x1) -> - begin _self.expression _self _x0;_self.length_object _self _x1 end + begin _self.expression _self _x0;length_object _self _x1 end |Char_of_int ( _x0) -> begin _self.expression _self _x0 end |Char_to_int ( _x0) -> @@ -86813,12 +86821,15 @@ deps_program : deps_program fn begin _self.expression _self _x0 end |Number _ -> () |Object ( _x0) -> - begin _self.property_map _self _x0 end + begin 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 +|Null -> () +let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let case_clause : case_clause fn = fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end +let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin _self.block _self _x0 end |Variable ( _x0) -> @@ -86828,32 +86839,40 @@ deps_program : deps_program fn |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 _self.label _self _x0;_self.expression _self _x1;_self.block _self _x2 end + begin option label _self _x0;_self.expression _self _x1;_self.block _self _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option _self.for_ident_expression _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end + begin option for_ident_expression _self _x0;finish_ident_expression _self _x1;_self.for_ident _self _x2;for_direction _self _x3;_self.block _self _x4 end |Continue ( _x0) -> - begin _self.label _self _x0 end + begin label _self _x0 end |Break -> () |Return ( _x0) -> begin _self.expression _self _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.int_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list int_clause _self _x1;option _self.block _self _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.string_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list string_clause _self _x1;option _self.block _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 _self.block _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 _self.expression _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 _self.statement _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 ) +|Debugger -> () +let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin expression_desc _self _x0 end +let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin statement_desc _self _x0 end +let variable_declaration : variable_declaration fn = fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option _self.expression _self _x1 end +let block : block fn = fun _self arg -> list _self.statement _self arg +let program : program fn = fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end +let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;required_modules _self _x1 end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program } end @@ -101396,64 +101415,50 @@ module Js_record_map = struct #1 "js_record_map.ml" - open J - let [@inline] unknown _ x = x - let [@inline] 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 +open J +let [@inline] unknown _ x = x +let [@inline] 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; +type iter = { 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 _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> 'a + let label : label fn = unknown + let ident : ident fn = unknown + let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end + let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg + let 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 + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end + let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) + let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) + let for_direction : for_direction fn = unknown + let 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 + let length_object : length_object fn = unknown + let 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 +let _x1 = 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) -> @@ -101514,12 +101519,15 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 + begin let _x0 = 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 +|Null as v -> v + let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let 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 + let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin let _x0 = _self.block _self _x0 in Block ( _x0) end |Variable ( _x0) -> @@ -101531,27 +101539,27 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 _self.label _self _x0 in + begin let _x0 = option label _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 _self.for_ident_expression _self _x0 in -let _x1 = _self.finish_ident_expression _self _x1 in + begin let _x0 = option for_ident_expression _self _x0 in +let _x1 = finish_ident_expression _self _x1 in let _x2 = _self.for_ident _self _x2 in -let _x3 = _self.for_direction _self _x3 in +let _x3 = 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 + begin let _x0 = 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 _self.int_clause _self _x1 in +let _x1 = list int_clause _self _x1 in let _x2 = option _self.block _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 _self.string_clause _self _x1 in +let _x1 = list string_clause _self _x1 in let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_x2) end |Throw ( _x0) -> begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end @@ -101559,20 +101567,28 @@ let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_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 _self.block _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 _self.expression _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 _self.statement _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 ) - } - +|Debugger as v -> v + let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end + let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end + let 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 _self.expression _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end + let block : block fn = fun _self arg -> list _self.statement _self arg + let 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 + let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program +} + end module Js_pass_flatten : sig #1 "js_pass_flatten.mli" @@ -102031,203 +102047,154 @@ let program (js : J.program) = *) end -module Js_fold +module Js_record_fold = struct -#1 "js_fold.ml" - - open J - let [@inline] unknown _self _ = _self - let [@inline] option sub self = fun v -> - match v with - | None -> self - | 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 : - 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = - fun _f_a -> - function - | [] -> _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 = 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 +#1 "js_record_fold.ml" + +open J +let [@inline] unknown _ st _ = st +let [@inline] option sub self st = fun v -> + match v with + | None -> st + | Some v -> sub self st v +let rec list sub self st = fun x -> + match x with + | [] -> st + | x::xs -> + let st = sub self st x in + list sub self st xs + +type 'state iter = { + ident : ('state,ident) fn; + module_id : ('state,module_id) fn; + vident : ('state,vident) fn; + exception_ident : ('state,exception_ident) fn; + for_ident : ('state,for_ident) fn; + expression : ('state,expression) fn; + statement : ('state,statement) fn; + variable_declaration : ('state,variable_declaration) fn; + block : ('state,block) fn; + program : ('state,program) fn +} +and ('state,'a) fn = 'state iter -> 'state -> 'a -> 'state +let label : 'a . ('a,label) fn = unknown +let ident : 'a . ('a,ident) fn = unknown +let module_id : 'a . ('a,module_id) fn = fun _self st { id = _x0;kind = _x1} -> let st = _self.ident _self st _x0 in st +let required_modules : 'a . ('a,required_modules) fn = fun _self st arg -> list _self.module_id _self st arg +let vident : 'a . ('a,vident) fn = fun _self st -> function | Id ( _x0) -> -let _self = _self#ident _x0 in - _self + let st = _self.ident _self st _x0 in st |Qualified ( _x0,_x1) -> -let _self = _self#module_id _x0 in - _self -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 = 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 + let st = _self.module_id _self st _x0 in st +let exception_ident : 'a . ('a,exception_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_ident : 'a . ('a,for_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_direction : 'a . ('a,for_direction) fn = unknown +let property_map : 'a . ('a,property_map) fn = fun _self st arg -> list ((fun _self st (_x0,_x1) -> let st = _self.expression _self st _x1 in st )) _self st arg +let length_object : 'a . ('a,length_object) fn = unknown +let expression_desc : 'a . ('a,expression_desc) fn = fun _self st -> function | Length ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#length_object _x1 in - _self + let st = _self.expression _self st _x0 in let st = length_object _self st _x1 in st |Char_of_int ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Char_to_int ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Is_null_or_undefined ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |String_append ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self -|Bool _ -> _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Bool _ -> st |Typeof ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Js_not ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Seq ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Cond ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in -let _self = _self#expression _x2 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st |Bin ( _x0,_x1,_x2) -> -let _self = _self#expression _x1 in -let _self = _self#expression _x2 in - _self + let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st |FlatCall ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Call ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#expression) _self _x1 in - _self + let st = _self.expression _self st _x0 in let st = list _self.expression _self st _x1 in st |String_index ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Array_index ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Static_index ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |New ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in - _self + let st = _self.expression _self st _x0 in let st = option (fun _self st arg -> list _self.expression _self st arg) _self st _x1 in st |Var ( _x0) -> -let _self = _self#vident _x0 in - _self + let st = _self.vident _self st _x0 in st |Fun ( _x0,_x1,_x2,_x3) -> -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 + let st = list _self.ident _self st _x1 in let st = _self.block _self st _x2 in st +|Str _ -> st +|Unicode _ -> st +|Raw_js_code _ -> st |Array ( _x0,_x1) -> -let _self = list (fun _self -> _self#expression) _self _x0 in - _self + let st = list _self.expression _self st _x0 in st |Optional_block ( _x0,_x1) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Caml_block ( _x0,_x1,_x2,_x3) -> -let _self = list (fun _self -> _self#expression) _self _x0 in -let _self = _self#expression _x2 in - _self + let st = list _self.expression _self st _x0 in let st = _self.expression _self st _x2 in st |Caml_block_tag ( _x0) -> -let _self = _self#expression _x0 in - _self -|Number _ -> _self + let st = _self.expression _self st _x0 in st +|Number _ -> st |Object ( _x0) -> -let _self = _self#property_map _x0 in - _self -|Undefined -> _self -|Null -> _self -method for_ident_expression : for_ident_expression -> 'self_type = _self#expression -method finish_ident_expression : finish_ident_expression -> 'self_type = _self#expression -method statement_desc : statement_desc -> 'self_type = function + let st = property_map _self st _x0 in st +|Undefined -> st +|Null -> st +let for_ident_expression : 'a . ('a,for_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : 'a . ('a,finish_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let case_clause : 'a . ('a,case_clause) fn = fun _self st { switch_body = _x0;should_break = _x1;comment = _x2} -> let st = _self.block _self st _x0 in st +let string_clause : 'a . ('a,string_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let int_clause : 'a . ('a,int_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let statement_desc : 'a . ('a,statement_desc) fn = fun _self st -> function | Block ( _x0) -> -let _self = _self#block _x0 in - _self + let st = _self.block _self st _x0 in st |Variable ( _x0) -> -let _self = _self#variable_declaration _x0 in - _self + let st = _self.variable_declaration _self st _x0 in st |Exp ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |If ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = _self#block _x1 in -let _self = _self#block _x2 in - _self + let st = _self.expression _self st _x0 in let st = _self.block _self st _x1 in let st = _self.block _self st _x2 in st |While ( _x0,_x1,_x2,_x3) -> -let _self = option (fun _self -> _self#label) _self _x0 in -let _self = _self#expression _x1 in -let _self = _self#block _x2 in - _self + let st = option label _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.block _self st _x2 in st |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -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 -let _self = _self#block _x4 in - _self + let st = option for_ident_expression _self st _x0 in let st = finish_ident_expression _self st _x1 in let st = _self.for_ident _self st _x2 in let st = for_direction _self st _x3 in let st = _self.block _self st _x4 in st |Continue ( _x0) -> -let _self = _self#label _x0 in - _self -|Break -> _self + let st = label _self st _x0 in st +|Break -> st |Return ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Int_switch ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#int_clause) _self _x1 in -let _self = option (fun _self -> _self#block) _self _x2 in - _self + let st = _self.expression _self st _x0 in let st = list int_clause _self st _x1 in let st = option _self.block _self st _x2 in st |String_switch ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#string_clause) _self _x1 in -let _self = option (fun _self -> _self#block) _self _x2 in - _self + let st = _self.expression _self st _x0 in let st = list string_clause _self st _x1 in let st = option _self.block _self st _x2 in st |Throw ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Try ( _x0,_x1,_x2) -> -let _self = _self#block _x0 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 (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 = 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 - end + let st = _self.block _self st _x0 in let st = option ((fun _self st (_x0,_x1) -> let st = _self.exception_ident _self st _x0 in let st = _self.block _self st _x1 in st )) _self st _x1 in let st = option _self.block _self st _x2 in st +|Debugger -> st +let expression : 'a . ('a,expression) fn = fun _self st { expression_desc = _x0;comment = _x1} -> let st = expression_desc _self st _x0 in st +let statement : 'a . ('a,statement) fn = fun _self st { statement_desc = _x0;comment = _x1} -> let st = statement_desc _self st _x0 in st +let variable_declaration : 'a . ('a,variable_declaration) fn = fun _self st { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let st = _self.ident _self st _x0 in let st = option _self.expression _self st _x1 in st +let block : 'a . ('a,block) fn = fun _self st arg -> list _self.statement _self st arg +let program : 'a . ('a,program) fn = fun _self st { block = _x0;exports = _x1;export_set = _x2} -> let st = _self.block _self st _x0 in st +let deps_program : 'a . ('a,deps_program) fn = fun _self st { program = _x0;modules = _x1;side_effect = _x2} -> let st = _self.program _self st _x0 in let st = required_modules _self st _x1 in st +let super : 'state iter = { + ident; + module_id; + vident; + exception_ident; + for_ident; + expression; + statement; + variable_declaration; + block; + program +} end module Js_pass_scope : sig @@ -102370,118 +102337,100 @@ end = struct done ]} *) +type state = { + defined_idents : Set_ident.t; + used_idents : Set_ident.t; + loop_mutable_values : Set_ident.t; + mutable_values : Set_ident.t; + closured_idents : Set_ident.t; + in_loop : bool; +} -let scope_pass = - object(self) - inherit Js_fold.fold as super - - val defined_idents = Set_ident.empty - - (** [used_idents] - does not contain locally defined idents *) - val used_idents = Set_ident.empty - (** we need collect mutable values and loop defined varaibles *) - val loop_mutable_values = Set_ident.empty - - val mutable_values = Set_ident.empty - - val closured_idents = Set_ident.empty - - (** check if in loop or not *) - val in_loop = false - - method get_in_loop = in_loop - - method get_defined_idents = defined_idents - - method get_used_idents = used_idents - - method get_loop_mutable_values = loop_mutable_values - - method get_mutable_values = mutable_values - - method get_closured_idents = closured_idents - - method with_in_loop b = - if b = self#get_in_loop then self - else {< in_loop = b >} - (* Since it's loop mutable variable, for sure - it is mutable variable - *) - method with_loop_mutable_values b = - {< loop_mutable_values = b >} - - method add_loop_mutable_variable id = - {< loop_mutable_values = Set_ident.add loop_mutable_values id; - mutable_values = Set_ident.add mutable_values id - >} +let init_state = { + defined_idents = Set_ident.empty; + used_idents = Set_ident.empty; + loop_mutable_values = Set_ident.empty; + mutable_values = Set_ident.empty; + closured_idents = Set_ident.empty; + in_loop = false; +} +let with_in_loop (st:state) b = + if b = st.in_loop then st + else {st with in_loop = b} +let add_loop_mutable_variable (st : state) id = + { st with + loop_mutable_values = Set_ident.add st.loop_mutable_values id; + mutable_values = Set_ident.add st.mutable_values id + } +let add_mutable_variable (st: state) id = + { + st with + mutable_values = Set_ident.add st.mutable_values id + } +let add_defined_ident (st : state) id = { + st with + defined_idents = Set_ident.add st.defined_idents id +} +let add_used_ident (st : state) id = { + st with used_idents = Set_ident.add st.used_idents id +} - method add_mutable_variable id = - {< mutable_values = Set_ident.add mutable_values id >} - method add_defined_ident ident = - {< defined_idents = Set_ident.add defined_idents ident >} - method add_used_ident ident = - {< used_idents = Set_ident.add used_idents ident >} - method! expression x = - match x.expression_desc with - | Fun (_method_, params, block , env) -> - (* Function is the only place to introduce a new scope in - ES5 - TODO: check - {[ try .. catch(exn) {.. }]} - what's the scope of exn - *) - (* Note that [used_idents] is not complete - it ignores some locally defined idents *) - let param_set = Set_ident.of_list params in - let obj = {} # block block in - let defined_idents', used_idents' = - obj#get_defined_idents, obj#get_used_idents in - (* mark which param is used *) - params |> List.iteri - (fun i v -> - if not (Set_ident.mem used_idents' v) then - Js_fun_env.mark_unused env i) ; - let closured_idents' = (* pass param_set down *) - Set_ident.(diff used_idents' (union defined_idents' param_set )) in - - (* Noe that we don't know which variables are exactly mutable yet .. - due to the recursive thing - *) - Js_fun_env.set_unbounded env closured_idents' ; - let lexical_scopes = Set_ident.(inter closured_idents' self#get_loop_mutable_values) in - Js_fun_env.set_lexical_scope env lexical_scopes; - (* tailcall , note that these varibles are used in another pass *) - {< used_idents = - Set_ident.union used_idents closured_idents' ; - (* There is a bug in ocaml -dsource*) - closured_idents = Set_ident.union closured_idents closured_idents' - >} - | _ -> - let obj = super#expression x in - match Js_block_runtime.check_additional_id x with - | None -> obj - | Some id -> - obj#add_used_ident id - (* TODO: most variables are immutable *) - - method! variable_declaration x = +let super = Js_record_fold.super +let record_scope_pass = { + super with + expression = begin fun self state x -> + match x.expression_desc with + | Fun (_method_, params, block , env) -> + (* Function is the only place to introduce a new scope in + ES5 + TODO: check + {[ try .. catch(exn) {.. }]} + what's the scope of exn + *) + (* Note that [used_idents] is not complete + it ignores some locally defined idents *) + let param_set = Set_ident.of_list params in + let {defined_idents = defined_idents' ; used_idents = used_idents' } = self.block self { + init_state with + mutable_values = Set_ident.of_list (Js_fun_env.get_mutable_params params env) ; + } block in + (* let defined_idents', used_idents' = + obj#get_defined_idents, obj#get_used_idents in *) + (* mark which param is used *) + params |> List.iteri + (fun i v -> + if not (Set_ident.mem used_idents' v) then + Js_fun_env.mark_unused env i) ; + let closured_idents' = (* pass param_set down *) + Set_ident.(diff used_idents' (union defined_idents' param_set )) in + + (* Noe that we don't know which variables are exactly mutable yet .. + due to the recursive thing + *) + Js_fun_env.set_unbounded env closured_idents' ; + let lexical_scopes = Set_ident.(inter closured_idents' state.loop_mutable_values) in + Js_fun_env.set_lexical_scope env lexical_scopes; + (* tailcall , note that these varibles are used in another pass *) + {state with used_idents = + Set_ident.union state.used_idents closured_idents' ; + (* There is a bug in ocaml -dsource*) + closured_idents = Set_ident.union state.closured_idents closured_idents' + } + | _ -> + let obj = super.expression self state x in + match Js_block_runtime.check_additional_id x with + | None -> obj + | Some id -> add_used_ident obj id + end; + variable_declaration = begin fun self state x -> match x with | { ident ; value; property } -> let obj = - (match self#get_in_loop, property with + add_defined_ident (match state.in_loop, property with | true, Variable -> - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident | true, (Strict | StrictOpt | Alias) (* Not real true immutable in javascript since it's in the loop @@ -102490,7 +102439,7 @@ let scope_pass = *) -> begin match value with - | None -> self#add_loop_mutable_variable ident + | None -> add_loop_mutable_variable state ident (* TODO: Check why assertion failure *) (* self#add_loop_mutable_variable ident *) (* assert false *) | Some x @@ -102505,7 +102454,7 @@ let scope_pass = *) match x.expression_desc with | Fun _ | Number _ | Str _ - -> self + -> state | _ -> (* if Set_ident.(is_empty @@ *) (* inter self#get_mutable_values *) @@ -102516,83 +102465,90 @@ let scope_pass = (* (\* FIXME: still need to check expression is pure or not*\) *) (* self *) (* else *) - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident end | false, Variable -> - self#add_mutable_variable ident + add_mutable_variable state ident | false, (Strict | StrictOpt | Alias) - -> self - )#add_defined_ident ident + -> state + ) ident in begin match value with | None -> obj - | Some x -> obj # expression x + | Some x -> self.expression self obj x end - - - method! statement x = + end; + statement = begin fun self state x -> match x.statement_desc with - | ForRange (_,_, loop_id, _,_,a_env) as y -> (* TODO: simplify definition of For *) - let obj = - {< in_loop = true ; - loop_mutable_values = Set_ident.singleton loop_id ; - used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) - defined_idents = Set_ident.singleton loop_id ; - closured_idents = Set_ident.empty (* Think about nested for blocks *) - (* Invariant: Finish id is never used *) - >} - # statement_desc y in - - let defined_idents', used_idents', closured_idents' = - obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in - - - let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') self#get_loop_mutable_values) in + | ForRange (_,_, loop_id, _,_,a_env) -> (* TODO: simplify definition of For *) + let {defined_idents = defined_idents'; used_idents = used_idents'; closured_idents = closured_idents'} = + + super.statement self { in_loop = true ; + loop_mutable_values = Set_ident.singleton loop_id ; + used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) + defined_idents = Set_ident.singleton loop_id ; + closured_idents = Set_ident.empty ;(* Think about nested for blocks *) + (* Invariant: Finish id is never used *) + mutable_values = state.mutable_values + } x in (* CHECK*) + + (* let defined_idents', used_idents', closured_idents' = + obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in *) + + + let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') state.loop_mutable_values) in let () = Js_closure.set_lexical_scope a_env lexical_scope in (* set scope *) - {< used_idents = Set_ident.union used_idents used_idents'; + { state with + used_idents = Set_ident.union state.used_idents used_idents'; (* walk around ocaml -dsource bug {[ Set_ident.(union used_idents used_idents) ]} *) - defined_idents = Set_ident.union defined_idents defined_idents'; + defined_idents = Set_ident.union state.defined_idents defined_idents'; (* TODO: if we our generated code also follow lexical scope, this is not necessary ; [varaibles] are mutable or not is known at definition *) - closured_idents = Set_ident.union closured_idents lexical_scope - >} + closured_idents = Set_ident.union state.closured_idents lexical_scope + } | While (_label,pred,body, _env) -> - (((self#expression pred)#with_in_loop true) # block body ) - #with_in_loop (self#get_in_loop) + with_in_loop (self.block self (with_in_loop (self.expression self state pred) true) body ) + (state.in_loop) | _ -> - super#statement x - - method! exception_ident x = - (* we can not simply skip it, since it can be used - TODO: check loop exception - (loop { - excption(i){ - () => {i} - } - }) - *) - {< used_idents = Set_ident.add used_idents x ; - defined_idents = Set_ident.add defined_idents x - >} - method! for_ident x = {< loop_mutable_values = Set_ident.add loop_mutable_values x >} - - method! ident x = - if Set_ident.mem defined_idents x then - self - else {< used_idents = Set_ident.add used_idents x >} - end + super.statement self state x + end; + + + exception_ident = begin fun _ state x -> + (* we can not simply skip it, since it can be used + TODO: check loop exception + (loop { + excption(i){ + () => {i} + } + }) + *) + {state with used_idents = Set_ident.add state.used_idents x ; + defined_idents = Set_ident.add state.defined_idents x + } + end; + for_ident = begin fun _ state x -> {state with loop_mutable_values = Set_ident.add state.loop_mutable_values x } end; + + ident = begin fun _ state x -> + if Set_ident.mem state.defined_idents x then + state + else {state with used_idents = Set_ident.add state.used_idents x } + end +} + let program js = - (scope_pass # program js ) # get_loop_mutable_values + (record_scope_pass.program record_scope_pass init_state js).loop_mutable_values + (* (scope_pass # program js ) # get_loop_mutable_values *) end module Js_pass_get_used : sig diff --git a/lib/4.06.1/unstable/js_compiler.ml.d b/lib/4.06.1/unstable/js_compiler.ml.d index c64dd6f420..ad6f4a627a 100644 --- a/lib/4.06.1/unstable/js_compiler.ml.d +++ b/lib/4.06.1/unstable/js_compiler.ml.d @@ -175,7 +175,6 @@ ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_dump_string.mli ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_exp_make.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_exp_make.mli -../lib/4.06.1/unstable/js_compiler.ml: ./core/js_fold.ml ../lib/4.06.1/unstable/js_compiler.ml: ./core/js_fold_basic.ml ../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 @@ -220,6 +219,7 @@ ../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_fold.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 diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml index 617a075f96..12903c08fd 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml @@ -81801,7 +81801,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) @@ -85816,7 +85816,6 @@ type property_name = Js_op.property_name type label = string -and required_modules = module_id list and ident = Ident.t (* we override `method ident` *) @@ -85829,6 +85828,7 @@ and ident = Ident.t (* we override `method ident` *) and module_id = { id : ident; kind : Js_op.kind } +and required_modules = module_id list and vident = | Id of ident | Qualified of module_id * string option @@ -86028,7 +86028,14 @@ and finish_ident_expression = expression (* pure *) } ]} *) +and case_clause = { + switch_body : block ; + should_break : bool ; (* true means break *) + comment : string option ; +} +and string_clause = string * case_clause +and int_clause = int * case_clause and statement_desc = | Block of block @@ -86080,13 +86087,6 @@ and variable_declaration = { property : property; ident_info : ident_info; } -and string_clause = string * case_clause -and int_clause = int * case_clause -and case_clause = { - switch_body : block ; - should_break : bool ; (* true means break *) - comment : string option ; -} (* TODO: For efficency: block should not be a list, it should be able to be concatenated in both ways @@ -86105,7 +86105,29 @@ and deps_program = modules : required_modules ; side_effect : string option (* None: no, Some reason *) } - [@@deriving] +[@@deriving {excludes = [| + deps_program ; + int_clause; + string_clause ; + for_direction; + (* exception_ident; *) + for_direction; + expression_desc; + statement_desc; + for_ident_expression; + label; + finish_ident_expression; + property_map; + length_object; + (* for_ident; *) + required_modules; + case_clause + |] }] +(* +FIXME: customize for each code generator +for each code generator, we can provide a white-list +so that we can achieve the optimal +*) end module Js_dump_lit = struct @@ -86708,63 +86730,49 @@ module Js_record_iter = struct #1 "js_record_iter.ml" - open J - let unknown _ _ = () - let [@inline] 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 +open J +let unknown _ _ = () +let [@inline] 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; +type iter = { 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 super : iter = { - label : label fn = ( unknown ) ; - required_modules : required_modules fn = ( fun _self arg -> list _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> unit +let label : label fn = unknown +let ident : ident fn = unknown +let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end +let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg +let 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 + begin _self.module_id _self _x0 end +let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) +let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) +let for_direction : for_direction fn = unknown +let property_map : property_map fn = fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg +let length_object : length_object fn = unknown +let expression_desc : expression_desc fn = fun _self -> function | Length ( _x0,_x1) -> - begin _self.expression _self _x0;_self.length_object _self _x1 end + begin _self.expression _self _x0;length_object _self _x1 end |Char_of_int ( _x0) -> begin _self.expression _self _x0 end |Char_to_int ( _x0) -> @@ -86813,12 +86821,15 @@ deps_program : deps_program fn begin _self.expression _self _x0 end |Number _ -> () |Object ( _x0) -> - begin _self.property_map _self _x0 end + begin 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 +|Null -> () +let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let case_clause : case_clause fn = fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end +let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin _self.block _self _x0 end |Variable ( _x0) -> @@ -86828,32 +86839,40 @@ deps_program : deps_program fn |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 _self.label _self _x0;_self.expression _self _x1;_self.block _self _x2 end + begin option label _self _x0;_self.expression _self _x1;_self.block _self _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option _self.for_ident_expression _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end + begin option for_ident_expression _self _x0;finish_ident_expression _self _x1;_self.for_ident _self _x2;for_direction _self _x3;_self.block _self _x4 end |Continue ( _x0) -> - begin _self.label _self _x0 end + begin label _self _x0 end |Break -> () |Return ( _x0) -> begin _self.expression _self _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.int_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list int_clause _self _x1;option _self.block _self _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.string_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list string_clause _self _x1;option _self.block _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 _self.block _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 _self.expression _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 _self.statement _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 ) +|Debugger -> () +let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin expression_desc _self _x0 end +let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin statement_desc _self _x0 end +let variable_declaration : variable_declaration fn = fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option _self.expression _self _x1 end +let block : block fn = fun _self arg -> list _self.statement _self arg +let program : program fn = fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end +let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;required_modules _self _x1 end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program } end @@ -101396,64 +101415,50 @@ module Js_record_map = struct #1 "js_record_map.ml" - open J - let [@inline] unknown _ x = x - let [@inline] 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 +open J +let [@inline] unknown _ x = x +let [@inline] 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; +type iter = { 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 _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> 'a + let label : label fn = unknown + let ident : ident fn = unknown + let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end + let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg + let 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 + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end + let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) + let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) + let for_direction : for_direction fn = unknown + let 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 + let length_object : length_object fn = unknown + let 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 +let _x1 = 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) -> @@ -101514,12 +101519,15 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 + begin let _x0 = 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 +|Null as v -> v + let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let 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 + let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin let _x0 = _self.block _self _x0 in Block ( _x0) end |Variable ( _x0) -> @@ -101531,27 +101539,27 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 _self.label _self _x0 in + begin let _x0 = option label _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 _self.for_ident_expression _self _x0 in -let _x1 = _self.finish_ident_expression _self _x1 in + begin let _x0 = option for_ident_expression _self _x0 in +let _x1 = finish_ident_expression _self _x1 in let _x2 = _self.for_ident _self _x2 in -let _x3 = _self.for_direction _self _x3 in +let _x3 = 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 + begin let _x0 = 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 _self.int_clause _self _x1 in +let _x1 = list int_clause _self _x1 in let _x2 = option _self.block _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 _self.string_clause _self _x1 in +let _x1 = list string_clause _self _x1 in let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_x2) end |Throw ( _x0) -> begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end @@ -101559,20 +101567,28 @@ let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_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 _self.block _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 _self.expression _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 _self.statement _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 ) - } - +|Debugger as v -> v + let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end + let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end + let 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 _self.expression _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end + let block : block fn = fun _self arg -> list _self.statement _self arg + let 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 + let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program +} + end module Js_pass_flatten : sig #1 "js_pass_flatten.mli" @@ -102031,203 +102047,154 @@ let program (js : J.program) = *) end -module Js_fold +module Js_record_fold = struct -#1 "js_fold.ml" - - open J - let [@inline] unknown _self _ = _self - let [@inline] option sub self = fun v -> - match v with - | None -> self - | 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 : - 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = - fun _f_a -> - function - | [] -> _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 = 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 +#1 "js_record_fold.ml" + +open J +let [@inline] unknown _ st _ = st +let [@inline] option sub self st = fun v -> + match v with + | None -> st + | Some v -> sub self st v +let rec list sub self st = fun x -> + match x with + | [] -> st + | x::xs -> + let st = sub self st x in + list sub self st xs + +type 'state iter = { + ident : ('state,ident) fn; + module_id : ('state,module_id) fn; + vident : ('state,vident) fn; + exception_ident : ('state,exception_ident) fn; + for_ident : ('state,for_ident) fn; + expression : ('state,expression) fn; + statement : ('state,statement) fn; + variable_declaration : ('state,variable_declaration) fn; + block : ('state,block) fn; + program : ('state,program) fn +} +and ('state,'a) fn = 'state iter -> 'state -> 'a -> 'state +let label : 'a . ('a,label) fn = unknown +let ident : 'a . ('a,ident) fn = unknown +let module_id : 'a . ('a,module_id) fn = fun _self st { id = _x0;kind = _x1} -> let st = _self.ident _self st _x0 in st +let required_modules : 'a . ('a,required_modules) fn = fun _self st arg -> list _self.module_id _self st arg +let vident : 'a . ('a,vident) fn = fun _self st -> function | Id ( _x0) -> -let _self = _self#ident _x0 in - _self + let st = _self.ident _self st _x0 in st |Qualified ( _x0,_x1) -> -let _self = _self#module_id _x0 in - _self -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 = 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 + let st = _self.module_id _self st _x0 in st +let exception_ident : 'a . ('a,exception_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_ident : 'a . ('a,for_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_direction : 'a . ('a,for_direction) fn = unknown +let property_map : 'a . ('a,property_map) fn = fun _self st arg -> list ((fun _self st (_x0,_x1) -> let st = _self.expression _self st _x1 in st )) _self st arg +let length_object : 'a . ('a,length_object) fn = unknown +let expression_desc : 'a . ('a,expression_desc) fn = fun _self st -> function | Length ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#length_object _x1 in - _self + let st = _self.expression _self st _x0 in let st = length_object _self st _x1 in st |Char_of_int ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Char_to_int ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Is_null_or_undefined ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |String_append ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self -|Bool _ -> _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Bool _ -> st |Typeof ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Js_not ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Seq ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Cond ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in -let _self = _self#expression _x2 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st |Bin ( _x0,_x1,_x2) -> -let _self = _self#expression _x1 in -let _self = _self#expression _x2 in - _self + let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st |FlatCall ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Call ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#expression) _self _x1 in - _self + let st = _self.expression _self st _x0 in let st = list _self.expression _self st _x1 in st |String_index ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Array_index ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Static_index ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |New ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in - _self + let st = _self.expression _self st _x0 in let st = option (fun _self st arg -> list _self.expression _self st arg) _self st _x1 in st |Var ( _x0) -> -let _self = _self#vident _x0 in - _self + let st = _self.vident _self st _x0 in st |Fun ( _x0,_x1,_x2,_x3) -> -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 + let st = list _self.ident _self st _x1 in let st = _self.block _self st _x2 in st +|Str _ -> st +|Unicode _ -> st +|Raw_js_code _ -> st |Array ( _x0,_x1) -> -let _self = list (fun _self -> _self#expression) _self _x0 in - _self + let st = list _self.expression _self st _x0 in st |Optional_block ( _x0,_x1) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Caml_block ( _x0,_x1,_x2,_x3) -> -let _self = list (fun _self -> _self#expression) _self _x0 in -let _self = _self#expression _x2 in - _self + let st = list _self.expression _self st _x0 in let st = _self.expression _self st _x2 in st |Caml_block_tag ( _x0) -> -let _self = _self#expression _x0 in - _self -|Number _ -> _self + let st = _self.expression _self st _x0 in st +|Number _ -> st |Object ( _x0) -> -let _self = _self#property_map _x0 in - _self -|Undefined -> _self -|Null -> _self -method for_ident_expression : for_ident_expression -> 'self_type = _self#expression -method finish_ident_expression : finish_ident_expression -> 'self_type = _self#expression -method statement_desc : statement_desc -> 'self_type = function + let st = property_map _self st _x0 in st +|Undefined -> st +|Null -> st +let for_ident_expression : 'a . ('a,for_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : 'a . ('a,finish_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let case_clause : 'a . ('a,case_clause) fn = fun _self st { switch_body = _x0;should_break = _x1;comment = _x2} -> let st = _self.block _self st _x0 in st +let string_clause : 'a . ('a,string_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let int_clause : 'a . ('a,int_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let statement_desc : 'a . ('a,statement_desc) fn = fun _self st -> function | Block ( _x0) -> -let _self = _self#block _x0 in - _self + let st = _self.block _self st _x0 in st |Variable ( _x0) -> -let _self = _self#variable_declaration _x0 in - _self + let st = _self.variable_declaration _self st _x0 in st |Exp ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |If ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = _self#block _x1 in -let _self = _self#block _x2 in - _self + let st = _self.expression _self st _x0 in let st = _self.block _self st _x1 in let st = _self.block _self st _x2 in st |While ( _x0,_x1,_x2,_x3) -> -let _self = option (fun _self -> _self#label) _self _x0 in -let _self = _self#expression _x1 in -let _self = _self#block _x2 in - _self + let st = option label _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.block _self st _x2 in st |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -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 -let _self = _self#block _x4 in - _self + let st = option for_ident_expression _self st _x0 in let st = finish_ident_expression _self st _x1 in let st = _self.for_ident _self st _x2 in let st = for_direction _self st _x3 in let st = _self.block _self st _x4 in st |Continue ( _x0) -> -let _self = _self#label _x0 in - _self -|Break -> _self + let st = label _self st _x0 in st +|Break -> st |Return ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Int_switch ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#int_clause) _self _x1 in -let _self = option (fun _self -> _self#block) _self _x2 in - _self + let st = _self.expression _self st _x0 in let st = list int_clause _self st _x1 in let st = option _self.block _self st _x2 in st |String_switch ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#string_clause) _self _x1 in -let _self = option (fun _self -> _self#block) _self _x2 in - _self + let st = _self.expression _self st _x0 in let st = list string_clause _self st _x1 in let st = option _self.block _self st _x2 in st |Throw ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Try ( _x0,_x1,_x2) -> -let _self = _self#block _x0 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 (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 = 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 - end + let st = _self.block _self st _x0 in let st = option ((fun _self st (_x0,_x1) -> let st = _self.exception_ident _self st _x0 in let st = _self.block _self st _x1 in st )) _self st _x1 in let st = option _self.block _self st _x2 in st +|Debugger -> st +let expression : 'a . ('a,expression) fn = fun _self st { expression_desc = _x0;comment = _x1} -> let st = expression_desc _self st _x0 in st +let statement : 'a . ('a,statement) fn = fun _self st { statement_desc = _x0;comment = _x1} -> let st = statement_desc _self st _x0 in st +let variable_declaration : 'a . ('a,variable_declaration) fn = fun _self st { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let st = _self.ident _self st _x0 in let st = option _self.expression _self st _x1 in st +let block : 'a . ('a,block) fn = fun _self st arg -> list _self.statement _self st arg +let program : 'a . ('a,program) fn = fun _self st { block = _x0;exports = _x1;export_set = _x2} -> let st = _self.block _self st _x0 in st +let deps_program : 'a . ('a,deps_program) fn = fun _self st { program = _x0;modules = _x1;side_effect = _x2} -> let st = _self.program _self st _x0 in let st = required_modules _self st _x1 in st +let super : 'state iter = { + ident; + module_id; + vident; + exception_ident; + for_ident; + expression; + statement; + variable_declaration; + block; + program +} end module Js_pass_scope : sig @@ -102370,118 +102337,100 @@ end = struct done ]} *) +type state = { + defined_idents : Set_ident.t; + used_idents : Set_ident.t; + loop_mutable_values : Set_ident.t; + mutable_values : Set_ident.t; + closured_idents : Set_ident.t; + in_loop : bool; +} -let scope_pass = - object(self) - inherit Js_fold.fold as super - - val defined_idents = Set_ident.empty - - (** [used_idents] - does not contain locally defined idents *) - val used_idents = Set_ident.empty - (** we need collect mutable values and loop defined varaibles *) - val loop_mutable_values = Set_ident.empty - - val mutable_values = Set_ident.empty - - val closured_idents = Set_ident.empty - - (** check if in loop or not *) - val in_loop = false - - method get_in_loop = in_loop - - method get_defined_idents = defined_idents - - method get_used_idents = used_idents - - method get_loop_mutable_values = loop_mutable_values - - method get_mutable_values = mutable_values - - method get_closured_idents = closured_idents - - method with_in_loop b = - if b = self#get_in_loop then self - else {< in_loop = b >} - (* Since it's loop mutable variable, for sure - it is mutable variable - *) - method with_loop_mutable_values b = - {< loop_mutable_values = b >} - - method add_loop_mutable_variable id = - {< loop_mutable_values = Set_ident.add loop_mutable_values id; - mutable_values = Set_ident.add mutable_values id - >} +let init_state = { + defined_idents = Set_ident.empty; + used_idents = Set_ident.empty; + loop_mutable_values = Set_ident.empty; + mutable_values = Set_ident.empty; + closured_idents = Set_ident.empty; + in_loop = false; +} +let with_in_loop (st:state) b = + if b = st.in_loop then st + else {st with in_loop = b} +let add_loop_mutable_variable (st : state) id = + { st with + loop_mutable_values = Set_ident.add st.loop_mutable_values id; + mutable_values = Set_ident.add st.mutable_values id + } +let add_mutable_variable (st: state) id = + { + st with + mutable_values = Set_ident.add st.mutable_values id + } +let add_defined_ident (st : state) id = { + st with + defined_idents = Set_ident.add st.defined_idents id +} +let add_used_ident (st : state) id = { + st with used_idents = Set_ident.add st.used_idents id +} - method add_mutable_variable id = - {< mutable_values = Set_ident.add mutable_values id >} - method add_defined_ident ident = - {< defined_idents = Set_ident.add defined_idents ident >} - method add_used_ident ident = - {< used_idents = Set_ident.add used_idents ident >} - method! expression x = - match x.expression_desc with - | Fun (_method_, params, block , env) -> - (* Function is the only place to introduce a new scope in - ES5 - TODO: check - {[ try .. catch(exn) {.. }]} - what's the scope of exn - *) - (* Note that [used_idents] is not complete - it ignores some locally defined idents *) - let param_set = Set_ident.of_list params in - let obj = {} # block block in - let defined_idents', used_idents' = - obj#get_defined_idents, obj#get_used_idents in - (* mark which param is used *) - params |> List.iteri - (fun i v -> - if not (Set_ident.mem used_idents' v) then - Js_fun_env.mark_unused env i) ; - let closured_idents' = (* pass param_set down *) - Set_ident.(diff used_idents' (union defined_idents' param_set )) in - - (* Noe that we don't know which variables are exactly mutable yet .. - due to the recursive thing - *) - Js_fun_env.set_unbounded env closured_idents' ; - let lexical_scopes = Set_ident.(inter closured_idents' self#get_loop_mutable_values) in - Js_fun_env.set_lexical_scope env lexical_scopes; - (* tailcall , note that these varibles are used in another pass *) - {< used_idents = - Set_ident.union used_idents closured_idents' ; - (* There is a bug in ocaml -dsource*) - closured_idents = Set_ident.union closured_idents closured_idents' - >} - | _ -> - let obj = super#expression x in - match Js_block_runtime.check_additional_id x with - | None -> obj - | Some id -> - obj#add_used_ident id - (* TODO: most variables are immutable *) - - method! variable_declaration x = +let super = Js_record_fold.super +let record_scope_pass = { + super with + expression = begin fun self state x -> + match x.expression_desc with + | Fun (_method_, params, block , env) -> + (* Function is the only place to introduce a new scope in + ES5 + TODO: check + {[ try .. catch(exn) {.. }]} + what's the scope of exn + *) + (* Note that [used_idents] is not complete + it ignores some locally defined idents *) + let param_set = Set_ident.of_list params in + let {defined_idents = defined_idents' ; used_idents = used_idents' } = self.block self { + init_state with + mutable_values = Set_ident.of_list (Js_fun_env.get_mutable_params params env) ; + } block in + (* let defined_idents', used_idents' = + obj#get_defined_idents, obj#get_used_idents in *) + (* mark which param is used *) + params |> List.iteri + (fun i v -> + if not (Set_ident.mem used_idents' v) then + Js_fun_env.mark_unused env i) ; + let closured_idents' = (* pass param_set down *) + Set_ident.(diff used_idents' (union defined_idents' param_set )) in + + (* Noe that we don't know which variables are exactly mutable yet .. + due to the recursive thing + *) + Js_fun_env.set_unbounded env closured_idents' ; + let lexical_scopes = Set_ident.(inter closured_idents' state.loop_mutable_values) in + Js_fun_env.set_lexical_scope env lexical_scopes; + (* tailcall , note that these varibles are used in another pass *) + {state with used_idents = + Set_ident.union state.used_idents closured_idents' ; + (* There is a bug in ocaml -dsource*) + closured_idents = Set_ident.union state.closured_idents closured_idents' + } + | _ -> + let obj = super.expression self state x in + match Js_block_runtime.check_additional_id x with + | None -> obj + | Some id -> add_used_ident obj id + end; + variable_declaration = begin fun self state x -> match x with | { ident ; value; property } -> let obj = - (match self#get_in_loop, property with + add_defined_ident (match state.in_loop, property with | true, Variable -> - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident | true, (Strict | StrictOpt | Alias) (* Not real true immutable in javascript since it's in the loop @@ -102490,7 +102439,7 @@ let scope_pass = *) -> begin match value with - | None -> self#add_loop_mutable_variable ident + | None -> add_loop_mutable_variable state ident (* TODO: Check why assertion failure *) (* self#add_loop_mutable_variable ident *) (* assert false *) | Some x @@ -102505,7 +102454,7 @@ let scope_pass = *) match x.expression_desc with | Fun _ | Number _ | Str _ - -> self + -> state | _ -> (* if Set_ident.(is_empty @@ *) (* inter self#get_mutable_values *) @@ -102516,83 +102465,90 @@ let scope_pass = (* (\* FIXME: still need to check expression is pure or not*\) *) (* self *) (* else *) - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident end | false, Variable -> - self#add_mutable_variable ident + add_mutable_variable state ident | false, (Strict | StrictOpt | Alias) - -> self - )#add_defined_ident ident + -> state + ) ident in begin match value with | None -> obj - | Some x -> obj # expression x + | Some x -> self.expression self obj x end - - - method! statement x = + end; + statement = begin fun self state x -> match x.statement_desc with - | ForRange (_,_, loop_id, _,_,a_env) as y -> (* TODO: simplify definition of For *) - let obj = - {< in_loop = true ; - loop_mutable_values = Set_ident.singleton loop_id ; - used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) - defined_idents = Set_ident.singleton loop_id ; - closured_idents = Set_ident.empty (* Think about nested for blocks *) - (* Invariant: Finish id is never used *) - >} - # statement_desc y in - - let defined_idents', used_idents', closured_idents' = - obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in - - - let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') self#get_loop_mutable_values) in + | ForRange (_,_, loop_id, _,_,a_env) -> (* TODO: simplify definition of For *) + let {defined_idents = defined_idents'; used_idents = used_idents'; closured_idents = closured_idents'} = + + super.statement self { in_loop = true ; + loop_mutable_values = Set_ident.singleton loop_id ; + used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) + defined_idents = Set_ident.singleton loop_id ; + closured_idents = Set_ident.empty ;(* Think about nested for blocks *) + (* Invariant: Finish id is never used *) + mutable_values = state.mutable_values + } x in (* CHECK*) + + (* let defined_idents', used_idents', closured_idents' = + obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in *) + + + let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') state.loop_mutable_values) in let () = Js_closure.set_lexical_scope a_env lexical_scope in (* set scope *) - {< used_idents = Set_ident.union used_idents used_idents'; + { state with + used_idents = Set_ident.union state.used_idents used_idents'; (* walk around ocaml -dsource bug {[ Set_ident.(union used_idents used_idents) ]} *) - defined_idents = Set_ident.union defined_idents defined_idents'; + defined_idents = Set_ident.union state.defined_idents defined_idents'; (* TODO: if we our generated code also follow lexical scope, this is not necessary ; [varaibles] are mutable or not is known at definition *) - closured_idents = Set_ident.union closured_idents lexical_scope - >} + closured_idents = Set_ident.union state.closured_idents lexical_scope + } | While (_label,pred,body, _env) -> - (((self#expression pred)#with_in_loop true) # block body ) - #with_in_loop (self#get_in_loop) + with_in_loop (self.block self (with_in_loop (self.expression self state pred) true) body ) + (state.in_loop) | _ -> - super#statement x - - method! exception_ident x = - (* we can not simply skip it, since it can be used - TODO: check loop exception - (loop { - excption(i){ - () => {i} - } - }) - *) - {< used_idents = Set_ident.add used_idents x ; - defined_idents = Set_ident.add defined_idents x - >} - method! for_ident x = {< loop_mutable_values = Set_ident.add loop_mutable_values x >} - - method! ident x = - if Set_ident.mem defined_idents x then - self - else {< used_idents = Set_ident.add used_idents x >} - end + super.statement self state x + end; + + + exception_ident = begin fun _ state x -> + (* we can not simply skip it, since it can be used + TODO: check loop exception + (loop { + excption(i){ + () => {i} + } + }) + *) + {state with used_idents = Set_ident.add state.used_idents x ; + defined_idents = Set_ident.add state.defined_idents x + } + end; + for_ident = begin fun _ state x -> {state with loop_mutable_values = Set_ident.add state.loop_mutable_values x } end; + + ident = begin fun _ state x -> + if Set_ident.mem state.defined_idents x then + state + else {state with used_idents = Set_ident.add state.used_idents x } + end +} + let program js = - (scope_pass # program js ) # get_loop_mutable_values + (record_scope_pass.program record_scope_pass init_state js).loop_mutable_values + (* (scope_pass # program js ) # get_loop_mutable_values *) end module Js_pass_get_used : sig 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 2cf327a51d..7e660ab7dc 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml.d +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml.d @@ -177,7 +177,6 @@ ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_dump_string.mli ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_exp_make.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_exp_make.mli -../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_fold.ml ../lib/4.06.1/unstable/js_refmt_compiler.ml: ./core/js_fold_basic.ml ../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 @@ -222,6 +221,7 @@ ../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_fold.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 diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index c1191275fe..2a165d1243 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -365990,7 +365990,7 @@ external reraise: exn -> 'a = "%reraise" val finally : 'a -> - clean:('a -> 'c) -> + clean:('a -> unit) -> ('a -> 'b) -> 'b (* val try_it : (unit -> 'a) -> unit *) @@ -370069,7 +370069,6 @@ type property_name = Js_op.property_name type label = string -and required_modules = module_id list and ident = Ident.t (* we override `method ident` *) @@ -370082,6 +370081,7 @@ and ident = Ident.t (* we override `method ident` *) and module_id = { id : ident; kind : Js_op.kind } +and required_modules = module_id list and vident = | Id of ident | Qualified of module_id * string option @@ -370281,7 +370281,14 @@ and finish_ident_expression = expression (* pure *) } ]} *) +and case_clause = { + switch_body : block ; + should_break : bool ; (* true means break *) + comment : string option ; +} +and string_clause = string * case_clause +and int_clause = int * case_clause and statement_desc = | Block of block @@ -370333,13 +370340,6 @@ and variable_declaration = { property : property; ident_info : ident_info; } -and string_clause = string * case_clause -and int_clause = int * case_clause -and case_clause = { - switch_body : block ; - should_break : bool ; (* true means break *) - comment : string option ; -} (* TODO: For efficency: block should not be a list, it should be able to be concatenated in both ways @@ -370358,7 +370358,29 @@ and deps_program = modules : required_modules ; side_effect : string option (* None: no, Some reason *) } - [@@deriving] +[@@deriving {excludes = [| + deps_program ; + int_clause; + string_clause ; + for_direction; + (* exception_ident; *) + for_direction; + expression_desc; + statement_desc; + for_ident_expression; + label; + finish_ident_expression; + property_map; + length_object; + (* for_ident; *) + required_modules; + case_clause + |] }] +(* +FIXME: customize for each code generator +for each code generator, we can provide a white-list +so that we can achieve the optimal +*) end module Js_packages_info : sig #1 "js_packages_info.mli" @@ -376587,63 +376609,49 @@ module Js_record_iter = struct #1 "js_record_iter.ml" - open J - let unknown _ _ = () - let [@inline] 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 +open J +let unknown _ _ = () +let [@inline] 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; +type iter = { 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 super : iter = { - label : label fn = ( unknown ) ; - required_modules : required_modules fn = ( fun _self arg -> list _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> unit +let label : label fn = unknown +let ident : ident fn = unknown +let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin _self.ident _self _x0 end +let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg +let 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 + begin _self.module_id _self _x0 end +let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) +let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) +let for_direction : for_direction fn = unknown +let property_map : property_map fn = fun _self arg -> list ((fun _self (_x0,_x1) -> begin _self.expression _self _x1 end)) _self arg +let length_object : length_object fn = unknown +let expression_desc : expression_desc fn = fun _self -> function | Length ( _x0,_x1) -> - begin _self.expression _self _x0;_self.length_object _self _x1 end + begin _self.expression _self _x0;length_object _self _x1 end |Char_of_int ( _x0) -> begin _self.expression _self _x0 end |Char_to_int ( _x0) -> @@ -376692,12 +376700,15 @@ deps_program : deps_program fn begin _self.expression _self _x0 end |Number _ -> () |Object ( _x0) -> - begin _self.property_map _self _x0 end + begin 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 +|Null -> () +let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) +let case_clause : case_clause fn = fun _self { switch_body = _x0;should_break = _x1;comment = _x2} -> begin _self.block _self _x0 end +let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin case_clause _self _x1 end) +let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin _self.block _self _x0 end |Variable ( _x0) -> @@ -376707,32 +376718,40 @@ deps_program : deps_program fn |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 _self.label _self _x0;_self.expression _self _x1;_self.block _self _x2 end + begin option label _self _x0;_self.expression _self _x1;_self.block _self _x2 end |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> - begin option _self.for_ident_expression _self _x0;_self.finish_ident_expression _self _x1;_self.for_ident _self _x2;_self.for_direction _self _x3;_self.block _self _x4 end + begin option for_ident_expression _self _x0;finish_ident_expression _self _x1;_self.for_ident _self _x2;for_direction _self _x3;_self.block _self _x4 end |Continue ( _x0) -> - begin _self.label _self _x0 end + begin label _self _x0 end |Break -> () |Return ( _x0) -> begin _self.expression _self _x0 end |Int_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.int_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list int_clause _self _x1;option _self.block _self _x2 end |String_switch ( _x0,_x1,_x2) -> - begin _self.expression _self _x0;list _self.string_clause _self _x1;option _self.block _self _x2 end + begin _self.expression _self _x0;list string_clause _self _x1;option _self.block _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 _self.block _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 _self.expression _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 _self.statement _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 ) +|Debugger -> () +let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin expression_desc _self _x0 end +let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin statement_desc _self _x0 end +let variable_declaration : variable_declaration fn = fun _self { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> begin _self.ident _self _x0;option _self.expression _self _x1 end +let block : block fn = fun _self arg -> list _self.statement _self arg +let program : program fn = fun _self { block = _x0;exports = _x1;export_set = _x2} -> begin _self.block _self _x0 end +let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin _self.program _self _x0;required_modules _self _x1 end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program } end @@ -383890,64 +383909,50 @@ module Js_record_map = struct #1 "js_record_map.ml" - open J - let [@inline] unknown _ x = x - let [@inline] 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 +open J +let [@inline] unknown _ x = x +let [@inline] 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; +type iter = { 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 _self.module_id _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 +program : program fn +} +and 'a fn = iter -> 'a -> 'a + let label : label fn = unknown + let ident : ident fn = unknown + let module_id : module_id fn = fun _self { id = _x0;kind = _x1} -> begin let _x0 = _self.ident _self _x0 in {id = _x0;kind = _x1} end + let required_modules : required_modules fn = fun _self arg -> list _self.module_id _self arg + let 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 + begin let _x0 = _self.module_id _self _x0 in Qualified ( _x0,_x1) end + let exception_ident : exception_ident fn = (fun _self arg -> _self.ident _self arg) + let for_ident : for_ident fn = (fun _self arg -> _self.ident _self arg) + let for_direction : for_direction fn = unknown + let 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 + let length_object : length_object fn = unknown + let 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 +let _x1 = 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) -> @@ -384008,12 +384013,15 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 + begin let _x0 = 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 +|Null as v -> v + let for_ident_expression : for_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let finish_ident_expression : finish_ident_expression fn = (fun _self arg -> _self.expression _self arg) + let 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 + let string_clause : string_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let int_clause : int_clause fn = (fun _self (_x0,_x1) -> begin let _x1 = case_clause _self _x1 in (_x0,_x1) end) + let statement_desc : statement_desc fn = fun _self -> function | Block ( _x0) -> begin let _x0 = _self.block _self _x0 in Block ( _x0) end |Variable ( _x0) -> @@ -384025,27 +384033,27 @@ let _x2 = _self.expression _self _x2 in Caml_block ( _x0,_x1,_x2,_x3) end 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 _self.label _self _x0 in + begin let _x0 = option label _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 _self.for_ident_expression _self _x0 in -let _x1 = _self.finish_ident_expression _self _x1 in + begin let _x0 = option for_ident_expression _self _x0 in +let _x1 = finish_ident_expression _self _x1 in let _x2 = _self.for_ident _self _x2 in -let _x3 = _self.for_direction _self _x3 in +let _x3 = 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 + begin let _x0 = 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 _self.int_clause _self _x1 in +let _x1 = list int_clause _self _x1 in let _x2 = option _self.block _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 _self.string_clause _self _x1 in +let _x1 = list string_clause _self _x1 in let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_x2) end |Throw ( _x0) -> begin let _x0 = _self.expression _self _x0 in Throw ( _x0) end @@ -384053,20 +384061,28 @@ let _x2 = option _self.block _self _x2 in String_switch ( _x0,_x1,_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 _self.block _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 _self.expression _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 _self.statement _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 ) - } - +|Debugger as v -> v + let expression : expression fn = fun _self { expression_desc = _x0;comment = _x1} -> begin let _x0 = expression_desc _self _x0 in {expression_desc = _x0;comment = _x1} end + let statement : statement fn = fun _self { statement_desc = _x0;comment = _x1} -> begin let _x0 = statement_desc _self _x0 in {statement_desc = _x0;comment = _x1} end + let 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 _self.expression _self _x1 in {ident = _x0;value = _x1;property = _x2;ident_info = _x3} end + let block : block fn = fun _self arg -> list _self.statement _self arg + let 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 + let deps_program : deps_program fn = fun _self { program = _x0;modules = _x1;side_effect = _x2} -> begin let _x0 = _self.program _self _x0 in +let _x1 = required_modules _self _x1 in {program = _x0;modules = _x1;side_effect = _x2} end +let super : iter = { +ident; +module_id; +vident; +exception_ident; +for_ident; +expression; +statement; +variable_declaration; +block; +program +} + end module Js_pass_flatten : sig #1 "js_pass_flatten.mli" @@ -384525,203 +384541,154 @@ let program (js : J.program) = *) end -module Js_fold +module Js_record_fold = struct -#1 "js_fold.ml" - - open J - let [@inline] unknown _self _ = _self - let [@inline] option sub self = fun v -> - match v with - | None -> self - | 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 : - 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = - fun _f_a -> - function - | [] -> _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 = 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 +#1 "js_record_fold.ml" + +open J +let [@inline] unknown _ st _ = st +let [@inline] option sub self st = fun v -> + match v with + | None -> st + | Some v -> sub self st v +let rec list sub self st = fun x -> + match x with + | [] -> st + | x::xs -> + let st = sub self st x in + list sub self st xs + +type 'state iter = { + ident : ('state,ident) fn; + module_id : ('state,module_id) fn; + vident : ('state,vident) fn; + exception_ident : ('state,exception_ident) fn; + for_ident : ('state,for_ident) fn; + expression : ('state,expression) fn; + statement : ('state,statement) fn; + variable_declaration : ('state,variable_declaration) fn; + block : ('state,block) fn; + program : ('state,program) fn +} +and ('state,'a) fn = 'state iter -> 'state -> 'a -> 'state +let label : 'a . ('a,label) fn = unknown +let ident : 'a . ('a,ident) fn = unknown +let module_id : 'a . ('a,module_id) fn = fun _self st { id = _x0;kind = _x1} -> let st = _self.ident _self st _x0 in st +let required_modules : 'a . ('a,required_modules) fn = fun _self st arg -> list _self.module_id _self st arg +let vident : 'a . ('a,vident) fn = fun _self st -> function | Id ( _x0) -> -let _self = _self#ident _x0 in - _self + let st = _self.ident _self st _x0 in st |Qualified ( _x0,_x1) -> -let _self = _self#module_id _x0 in - _self -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 = 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 + let st = _self.module_id _self st _x0 in st +let exception_ident : 'a . ('a,exception_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_ident : 'a . ('a,for_ident) fn = (fun _self arg -> _self.ident _self arg) +let for_direction : 'a . ('a,for_direction) fn = unknown +let property_map : 'a . ('a,property_map) fn = fun _self st arg -> list ((fun _self st (_x0,_x1) -> let st = _self.expression _self st _x1 in st )) _self st arg +let length_object : 'a . ('a,length_object) fn = unknown +let expression_desc : 'a . ('a,expression_desc) fn = fun _self st -> function | Length ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#length_object _x1 in - _self + let st = _self.expression _self st _x0 in let st = length_object _self st _x1 in st |Char_of_int ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Char_to_int ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Is_null_or_undefined ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |String_append ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self -|Bool _ -> _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st +|Bool _ -> st |Typeof ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Js_not ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Seq ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Cond ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in -let _self = _self#expression _x2 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st |Bin ( _x0,_x1,_x2) -> -let _self = _self#expression _x1 in -let _self = _self#expression _x2 in - _self + let st = _self.expression _self st _x1 in let st = _self.expression _self st _x2 in st |FlatCall ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Call ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#expression) _self _x1 in - _self + let st = _self.expression _self st _x0 in let st = list _self.expression _self st _x1 in st |String_index ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Array_index ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = _self#expression _x1 in - _self + let st = _self.expression _self st _x0 in let st = _self.expression _self st _x1 in st |Static_index ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |New ( _x0,_x1) -> -let _self = _self#expression _x0 in -let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in - _self + let st = _self.expression _self st _x0 in let st = option (fun _self st arg -> list _self.expression _self st arg) _self st _x1 in st |Var ( _x0) -> -let _self = _self#vident _x0 in - _self + let st = _self.vident _self st _x0 in st |Fun ( _x0,_x1,_x2,_x3) -> -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 + let st = list _self.ident _self st _x1 in let st = _self.block _self st _x2 in st +|Str _ -> st +|Unicode _ -> st +|Raw_js_code _ -> st |Array ( _x0,_x1) -> -let _self = list (fun _self -> _self#expression) _self _x0 in - _self + let st = list _self.expression _self st _x0 in st |Optional_block ( _x0,_x1) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Caml_block ( _x0,_x1,_x2,_x3) -> -let _self = list (fun _self -> _self#expression) _self _x0 in -let _self = _self#expression _x2 in - _self + let st = list _self.expression _self st _x0 in let st = _self.expression _self st _x2 in st |Caml_block_tag ( _x0) -> -let _self = _self#expression _x0 in - _self -|Number _ -> _self + let st = _self.expression _self st _x0 in st +|Number _ -> st |Object ( _x0) -> -let _self = _self#property_map _x0 in - _self -|Undefined -> _self -|Null -> _self -method for_ident_expression : for_ident_expression -> 'self_type = _self#expression -method finish_ident_expression : finish_ident_expression -> 'self_type = _self#expression -method statement_desc : statement_desc -> 'self_type = function + let st = property_map _self st _x0 in st +|Undefined -> st +|Null -> st +let for_ident_expression : 'a . ('a,for_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let finish_ident_expression : 'a . ('a,finish_ident_expression) fn = (fun _self arg -> _self.expression _self arg) +let case_clause : 'a . ('a,case_clause) fn = fun _self st { switch_body = _x0;should_break = _x1;comment = _x2} -> let st = _self.block _self st _x0 in st +let string_clause : 'a . ('a,string_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let int_clause : 'a . ('a,int_clause) fn = (fun _self st (_x0,_x1) -> let st = case_clause _self st _x1 in st ) +let statement_desc : 'a . ('a,statement_desc) fn = fun _self st -> function | Block ( _x0) -> -let _self = _self#block _x0 in - _self + let st = _self.block _self st _x0 in st |Variable ( _x0) -> -let _self = _self#variable_declaration _x0 in - _self + let st = _self.variable_declaration _self st _x0 in st |Exp ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |If ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = _self#block _x1 in -let _self = _self#block _x2 in - _self + let st = _self.expression _self st _x0 in let st = _self.block _self st _x1 in let st = _self.block _self st _x2 in st |While ( _x0,_x1,_x2,_x3) -> -let _self = option (fun _self -> _self#label) _self _x0 in -let _self = _self#expression _x1 in -let _self = _self#block _x2 in - _self + let st = option label _self st _x0 in let st = _self.expression _self st _x1 in let st = _self.block _self st _x2 in st |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5) -> -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 -let _self = _self#block _x4 in - _self + let st = option for_ident_expression _self st _x0 in let st = finish_ident_expression _self st _x1 in let st = _self.for_ident _self st _x2 in let st = for_direction _self st _x3 in let st = _self.block _self st _x4 in st |Continue ( _x0) -> -let _self = _self#label _x0 in - _self -|Break -> _self + let st = label _self st _x0 in st +|Break -> st |Return ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Int_switch ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#int_clause) _self _x1 in -let _self = option (fun _self -> _self#block) _self _x2 in - _self + let st = _self.expression _self st _x0 in let st = list int_clause _self st _x1 in let st = option _self.block _self st _x2 in st |String_switch ( _x0,_x1,_x2) -> -let _self = _self#expression _x0 in -let _self = list (fun _self -> _self#string_clause) _self _x1 in -let _self = option (fun _self -> _self#block) _self _x2 in - _self + let st = _self.expression _self st _x0 in let st = list string_clause _self st _x1 in let st = option _self.block _self st _x2 in st |Throw ( _x0) -> -let _self = _self#expression _x0 in - _self + let st = _self.expression _self st _x0 in st |Try ( _x0,_x1,_x2) -> -let _self = _self#block _x0 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 (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 = 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 - end + let st = _self.block _self st _x0 in let st = option ((fun _self st (_x0,_x1) -> let st = _self.exception_ident _self st _x0 in let st = _self.block _self st _x1 in st )) _self st _x1 in let st = option _self.block _self st _x2 in st +|Debugger -> st +let expression : 'a . ('a,expression) fn = fun _self st { expression_desc = _x0;comment = _x1} -> let st = expression_desc _self st _x0 in st +let statement : 'a . ('a,statement) fn = fun _self st { statement_desc = _x0;comment = _x1} -> let st = statement_desc _self st _x0 in st +let variable_declaration : 'a . ('a,variable_declaration) fn = fun _self st { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let st = _self.ident _self st _x0 in let st = option _self.expression _self st _x1 in st +let block : 'a . ('a,block) fn = fun _self st arg -> list _self.statement _self st arg +let program : 'a . ('a,program) fn = fun _self st { block = _x0;exports = _x1;export_set = _x2} -> let st = _self.block _self st _x0 in st +let deps_program : 'a . ('a,deps_program) fn = fun _self st { program = _x0;modules = _x1;side_effect = _x2} -> let st = _self.program _self st _x0 in let st = required_modules _self st _x1 in st +let super : 'state iter = { + ident; + module_id; + vident; + exception_ident; + for_ident; + expression; + statement; + variable_declaration; + block; + program +} end module Js_pass_scope : sig @@ -384864,118 +384831,100 @@ end = struct done ]} *) +type state = { + defined_idents : Set_ident.t; + used_idents : Set_ident.t; + loop_mutable_values : Set_ident.t; + mutable_values : Set_ident.t; + closured_idents : Set_ident.t; + in_loop : bool; +} -let scope_pass = - object(self) - inherit Js_fold.fold as super - - val defined_idents = Set_ident.empty - - (** [used_idents] - does not contain locally defined idents *) - val used_idents = Set_ident.empty - (** we need collect mutable values and loop defined varaibles *) - val loop_mutable_values = Set_ident.empty - - val mutable_values = Set_ident.empty - - val closured_idents = Set_ident.empty - - (** check if in loop or not *) - val in_loop = false - - method get_in_loop = in_loop - - method get_defined_idents = defined_idents - - method get_used_idents = used_idents - - method get_loop_mutable_values = loop_mutable_values - - method get_mutable_values = mutable_values - - method get_closured_idents = closured_idents - - method with_in_loop b = - if b = self#get_in_loop then self - else {< in_loop = b >} - (* Since it's loop mutable variable, for sure - it is mutable variable - *) - method with_loop_mutable_values b = - {< loop_mutable_values = b >} - - method add_loop_mutable_variable id = - {< loop_mutable_values = Set_ident.add loop_mutable_values id; - mutable_values = Set_ident.add mutable_values id - >} +let init_state = { + defined_idents = Set_ident.empty; + used_idents = Set_ident.empty; + loop_mutable_values = Set_ident.empty; + mutable_values = Set_ident.empty; + closured_idents = Set_ident.empty; + in_loop = false; +} +let with_in_loop (st:state) b = + if b = st.in_loop then st + else {st with in_loop = b} +let add_loop_mutable_variable (st : state) id = + { st with + loop_mutable_values = Set_ident.add st.loop_mutable_values id; + mutable_values = Set_ident.add st.mutable_values id + } +let add_mutable_variable (st: state) id = + { + st with + mutable_values = Set_ident.add st.mutable_values id + } +let add_defined_ident (st : state) id = { + st with + defined_idents = Set_ident.add st.defined_idents id +} +let add_used_ident (st : state) id = { + st with used_idents = Set_ident.add st.used_idents id +} - method add_mutable_variable id = - {< mutable_values = Set_ident.add mutable_values id >} - method add_defined_ident ident = - {< defined_idents = Set_ident.add defined_idents ident >} - method add_used_ident ident = - {< used_idents = Set_ident.add used_idents ident >} - method! expression x = - match x.expression_desc with - | Fun (_method_, params, block , env) -> - (* Function is the only place to introduce a new scope in - ES5 - TODO: check - {[ try .. catch(exn) {.. }]} - what's the scope of exn - *) - (* Note that [used_idents] is not complete - it ignores some locally defined idents *) - let param_set = Set_ident.of_list params in - let obj = {} # block block in - let defined_idents', used_idents' = - obj#get_defined_idents, obj#get_used_idents in - (* mark which param is used *) - params |> List.iteri - (fun i v -> - if not (Set_ident.mem used_idents' v) then - Js_fun_env.mark_unused env i) ; - let closured_idents' = (* pass param_set down *) - Set_ident.(diff used_idents' (union defined_idents' param_set )) in - - (* Noe that we don't know which variables are exactly mutable yet .. - due to the recursive thing - *) - Js_fun_env.set_unbounded env closured_idents' ; - let lexical_scopes = Set_ident.(inter closured_idents' self#get_loop_mutable_values) in - Js_fun_env.set_lexical_scope env lexical_scopes; - (* tailcall , note that these varibles are used in another pass *) - {< used_idents = - Set_ident.union used_idents closured_idents' ; - (* There is a bug in ocaml -dsource*) - closured_idents = Set_ident.union closured_idents closured_idents' - >} - | _ -> - let obj = super#expression x in - match Js_block_runtime.check_additional_id x with - | None -> obj - | Some id -> - obj#add_used_ident id - (* TODO: most variables are immutable *) - - method! variable_declaration x = +let super = Js_record_fold.super +let record_scope_pass = { + super with + expression = begin fun self state x -> + match x.expression_desc with + | Fun (_method_, params, block , env) -> + (* Function is the only place to introduce a new scope in + ES5 + TODO: check + {[ try .. catch(exn) {.. }]} + what's the scope of exn + *) + (* Note that [used_idents] is not complete + it ignores some locally defined idents *) + let param_set = Set_ident.of_list params in + let {defined_idents = defined_idents' ; used_idents = used_idents' } = self.block self { + init_state with + mutable_values = Set_ident.of_list (Js_fun_env.get_mutable_params params env) ; + } block in + (* let defined_idents', used_idents' = + obj#get_defined_idents, obj#get_used_idents in *) + (* mark which param is used *) + params |> List.iteri + (fun i v -> + if not (Set_ident.mem used_idents' v) then + Js_fun_env.mark_unused env i) ; + let closured_idents' = (* pass param_set down *) + Set_ident.(diff used_idents' (union defined_idents' param_set )) in + + (* Noe that we don't know which variables are exactly mutable yet .. + due to the recursive thing + *) + Js_fun_env.set_unbounded env closured_idents' ; + let lexical_scopes = Set_ident.(inter closured_idents' state.loop_mutable_values) in + Js_fun_env.set_lexical_scope env lexical_scopes; + (* tailcall , note that these varibles are used in another pass *) + {state with used_idents = + Set_ident.union state.used_idents closured_idents' ; + (* There is a bug in ocaml -dsource*) + closured_idents = Set_ident.union state.closured_idents closured_idents' + } + | _ -> + let obj = super.expression self state x in + match Js_block_runtime.check_additional_id x with + | None -> obj + | Some id -> add_used_ident obj id + end; + variable_declaration = begin fun self state x -> match x with | { ident ; value; property } -> let obj = - (match self#get_in_loop, property with + add_defined_ident (match state.in_loop, property with | true, Variable -> - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident | true, (Strict | StrictOpt | Alias) (* Not real true immutable in javascript since it's in the loop @@ -384984,7 +384933,7 @@ let scope_pass = *) -> begin match value with - | None -> self#add_loop_mutable_variable ident + | None -> add_loop_mutable_variable state ident (* TODO: Check why assertion failure *) (* self#add_loop_mutable_variable ident *) (* assert false *) | Some x @@ -384999,7 +384948,7 @@ let scope_pass = *) match x.expression_desc with | Fun _ | Number _ | Str _ - -> self + -> state | _ -> (* if Set_ident.(is_empty @@ *) (* inter self#get_mutable_values *) @@ -385010,83 +384959,90 @@ let scope_pass = (* (\* FIXME: still need to check expression is pure or not*\) *) (* self *) (* else *) - self#add_loop_mutable_variable ident + add_loop_mutable_variable state ident end | false, Variable -> - self#add_mutable_variable ident + add_mutable_variable state ident | false, (Strict | StrictOpt | Alias) - -> self - )#add_defined_ident ident + -> state + ) ident in begin match value with | None -> obj - | Some x -> obj # expression x + | Some x -> self.expression self obj x end - - - method! statement x = + end; + statement = begin fun self state x -> match x.statement_desc with - | ForRange (_,_, loop_id, _,_,a_env) as y -> (* TODO: simplify definition of For *) - let obj = - {< in_loop = true ; - loop_mutable_values = Set_ident.singleton loop_id ; - used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) - defined_idents = Set_ident.singleton loop_id ; - closured_idents = Set_ident.empty (* Think about nested for blocks *) - (* Invariant: Finish id is never used *) - >} - # statement_desc y in - - let defined_idents', used_idents', closured_idents' = - obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in - - - let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') self#get_loop_mutable_values) in + | ForRange (_,_, loop_id, _,_,a_env) -> (* TODO: simplify definition of For *) + let {defined_idents = defined_idents'; used_idents = used_idents'; closured_idents = closured_idents'} = + + super.statement self { in_loop = true ; + loop_mutable_values = Set_ident.singleton loop_id ; + used_idents = Set_ident.empty; (* TODO: if unused, can we generate better code? *) + defined_idents = Set_ident.singleton loop_id ; + closured_idents = Set_ident.empty ;(* Think about nested for blocks *) + (* Invariant: Finish id is never used *) + mutable_values = state.mutable_values + } x in (* CHECK*) + + (* let defined_idents', used_idents', closured_idents' = + obj#get_defined_idents, obj#get_used_idents, obj#get_closured_idents in *) + + + let lexical_scope = Set_ident.(inter (diff closured_idents' defined_idents') state.loop_mutable_values) in let () = Js_closure.set_lexical_scope a_env lexical_scope in (* set scope *) - {< used_idents = Set_ident.union used_idents used_idents'; + { state with + used_idents = Set_ident.union state.used_idents used_idents'; (* walk around ocaml -dsource bug {[ Set_ident.(union used_idents used_idents) ]} *) - defined_idents = Set_ident.union defined_idents defined_idents'; + defined_idents = Set_ident.union state.defined_idents defined_idents'; (* TODO: if we our generated code also follow lexical scope, this is not necessary ; [varaibles] are mutable or not is known at definition *) - closured_idents = Set_ident.union closured_idents lexical_scope - >} + closured_idents = Set_ident.union state.closured_idents lexical_scope + } | While (_label,pred,body, _env) -> - (((self#expression pred)#with_in_loop true) # block body ) - #with_in_loop (self#get_in_loop) + with_in_loop (self.block self (with_in_loop (self.expression self state pred) true) body ) + (state.in_loop) | _ -> - super#statement x - - method! exception_ident x = - (* we can not simply skip it, since it can be used - TODO: check loop exception - (loop { - excption(i){ - () => {i} - } - }) - *) - {< used_idents = Set_ident.add used_idents x ; - defined_idents = Set_ident.add defined_idents x - >} - method! for_ident x = {< loop_mutable_values = Set_ident.add loop_mutable_values x >} - - method! ident x = - if Set_ident.mem defined_idents x then - self - else {< used_idents = Set_ident.add used_idents x >} - end + super.statement self state x + end; + + + exception_ident = begin fun _ state x -> + (* we can not simply skip it, since it can be used + TODO: check loop exception + (loop { + excption(i){ + () => {i} + } + }) + *) + {state with used_idents = Set_ident.add state.used_idents x ; + defined_idents = Set_ident.add state.defined_idents x + } + end; + for_ident = begin fun _ state x -> {state with loop_mutable_values = Set_ident.add state.loop_mutable_values x } end; + + ident = begin fun _ state x -> + if Set_ident.mem state.defined_idents x then + state + else {state with used_idents = Set_ident.add state.used_idents x } + end +} + let program js = - (scope_pass # program js ) # get_loop_mutable_values + (record_scope_pass.program record_scope_pass init_state js).loop_mutable_values + (* (scope_pass # program js ) # get_loop_mutable_values *) end module Js_pass_get_used : sig diff --git a/lib/4.06.1/whole_compiler.ml.d b/lib/4.06.1/whole_compiler.ml.d index 2f83a8c74f..8f88d69630 100644 --- a/lib/4.06.1/whole_compiler.ml.d +++ b/lib/4.06.1/whole_compiler.ml.d @@ -187,7 +187,6 @@ ../lib/4.06.1/whole_compiler.ml: ./core/js_dump_string.mli ../lib/4.06.1/whole_compiler.ml: ./core/js_exp_make.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_exp_make.mli -../lib/4.06.1/whole_compiler.ml: ./core/js_fold.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_fold_basic.ml ../lib/4.06.1/whole_compiler.ml: ./core/js_fold_basic.mli ../lib/4.06.1/whole_compiler.ml: ./core/js_fun_env.ml @@ -234,6 +233,7 @@ ../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_fold.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 diff --git a/ocaml-tree/fold_maker.js b/ocaml-tree/fold_maker.js index a38723ceee..b11743075e 100644 --- a/ocaml-tree/fold_maker.js +++ b/ocaml-tree/fold_maker.js @@ -5,12 +5,14 @@ var init = node_types.init; /** * * @typedef {import('./node_types').Node} Node + * @typedef {import("./node_types").Names} Names + * @typedef {import ("./node_types").Type} Type */ /** * * @param {{name:string, def:Node}} typedef - * @param {Set} allNames + * @param {Names} allNames * @returns {string} */ function mkMethod({ name, def }, allNames) { @@ -19,7 +21,7 @@ function mkMethod({ name, def }, allNames) { var skip = `unknown _self`; /** * @param {Node} def - * @param {Set} allNames + * @param {Names} allNames */ function mkBody(def, allNames) { // @ts-ignore @@ -27,16 +29,19 @@ function mkBody(def, allNames) { switch (def.type) { case "type_constructor_path": var basic = node_types.isSupported(def, allNames); - if (basic !== undefined) { - return `_self#${basic}`; + switch (basic.kind) { + case "no": + return skip; + default: + //FIXME + return `_self#${basic.name}`; } - return skip; case "constructed_type": // FIXME var [list, base] = [...def.children].reverse(); switch (list.text) { case "option": - case "list": + case "list": var inner = mkBody(base, allNames); if (inner === skip) { return inner; @@ -81,7 +86,7 @@ function mkBody(def, allNames) { /** * * @param {Node} ty - * @param {Set} allNames + * @param {Names} allNames * @param {string} arg */ function mkBodyApply(ty, allNames, arg) { @@ -96,7 +101,7 @@ function mkBodyApply(ty, allNames, arg) { * * @param {Node} branch * branch is constructor_declaration - * @param {Set} allNames + * @param {Names} allNames * @returns {string} */ function mkBranch(branch, allNames) { @@ -125,12 +130,12 @@ function mkBranch(branch, allNames) { /** * - * @param {{name : string, def: Node}[]} typedefs + * @param {Type} type * @returns {string} */ -function make(typedefs) { - var allNames = new Set([...typedefs.map((x) => x.name), "option", "list"]); - var output = typedefs.map((x) => mkMethod(x, allNames)); +function make(type) { + var { types: typedefs, names } = type; + var output = typedefs.map((x) => mkMethod(x, names)); var o = ` open J let [@inline] unknown _self _ = _self diff --git a/ocaml-tree/iter_maker.js b/ocaml-tree/iter_maker.js deleted file mode 100644 index e80a904dfd..0000000000 --- a/ocaml-tree/iter_maker.js +++ /dev/null @@ -1,157 +0,0 @@ -//@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 `method ${name} : ${name} -> unit = ${mkBody(def, allNames)} `; -} - -var skip = `ignore`; - -/** - * @param {Node} def - * @param {Set} allNames - */ -function mkBody(def, allNames) { - // @ts-ignore - assert(def !== undefined); - switch (def.type) { - case "type_constructor_path": - var basic = node_types.isSupported(def, allNames); - if (basic !== undefined) { - return `_self#${basic}`; - } - return skip; - case "constructed_type": - // FIXME - var [list, base] = [...def.children].reverse(); - - switch (list.text) { - case "option": - case "list": - var inner = mkBody(base, allNames); - if (inner === skip) { - return inner; - } - 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}`); - } - - 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 { ${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 `function \n| ${branches.join("\n|")}`; - 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); - return `(fun ( ${args.join(",")}) -> begin ${body.join(";")} end)`; - default: - throw new Error(`unkonwn ${def.type}`); - } -} - -/** - * - * @param {Node} ty - * @param {Set} allNames - * @param {string} arg - */ -function mkBodyApply(ty, allNames, arg) { - var fn = mkBody(ty, allNames); - if (fn === skip) { - return ``; - } - return `${fn} ${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 allNames = new Set([...typedefs.map((x) => x.name), "option", "list"]); - var output = typedefs.map((x) => mkMethod(x, allNames)); - var o = ` - 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) - ${output.join("\n")} - end - `; - return o; -} -exports.make = make; diff --git a/ocaml-tree/map_maker.js b/ocaml-tree/map_maker.js deleted file mode 100644 index 6807f5ba5e..0000000000 --- a/ocaml-tree/map_maker.js +++ /dev/null @@ -1,154 +0,0 @@ -//@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 `method ${name} : ${name} -> ${name} = ${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": - var basic = node_types.isSupported(def, allNames); - if (basic !== undefined) { - return `_self#${basic}`; - } - return skip; - case "constructed_type": - // FIXME - var [list, base] = [...def.children].reverse(); - switch (list.text) { - case "option": - case "list": - var inner = mkBody(base, allNames); - if (inner === skip) { - return inner; - } - return `${list.text} (${inner})`; - 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}`); - var pat_exp = init(len, (i) => { - return `${def.children[i].mainText} = ${args[i]}`; - }); - var record_body = args - .map((arg, i) => { - var ty = def.children[i].children[1]; - return mkBodyApply(ty, allNames, arg); - }) - .filter(Boolean); - return `fun { ${pat_exp.join(";")}} -> ${record_body.join( - "\n" - )} {${pat_exp.join(";")}}`; - case "variant_declaration": - var len = def.children.length; - var branches = def.children.map((branch) => mkBranch(branch, allNames)); - return `function \n| ${branches.join("\n|")}`; - case "tuple_type": - var len = def.children.length; - var args = init(len, (i) => `_x${i}`); - var tuple_body = args - .map((x, i) => mkBodyApply(def.children[i], allNames, x)) - .filter(Boolean); - return `fun ( ${args.join(",")}) -> ${tuple_body.join(" ")} ${args.join( - "," - )}`; - default: - throw new Error(`unknown ${def.type}`); - } -} -/** - * - * @param {Node} ty - * @param {Set} allNames - * @param {string} arg - */ -function mkBodyApply(ty, allNames, arg) { - var fn = mkBody(ty, allNames); - if (fn === skip) { - return ``; - } - return `let ${arg} = ${fn} ${arg} in `; -} -/** - * - * @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${body.join("\n")}\n${pat_exp}`; -} -/** - * - * @param {{name:string, def:Node}[]} typedefs - */ -function make(typedefs) { - var allNames = new Set([...typedefs.map((x) => x.name), "option", "list"]); - var o = typedefs.map((x) => mkMethod(x, allNames)); - var output = ` -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)) -${o.join("\n")} -end -`; - return output; -} - -exports.make = make; diff --git a/ocaml-tree/node_types.js b/ocaml-tree/node_types.js index 13faa712c9..0c3654ad50 100644 --- a/ocaml-tree/node_types.js +++ b/ocaml-tree/node_types.js @@ -1,6 +1,12 @@ //@ts-check class Node { + /** + * + * @param {string} type + * @param {string} text + * @param {Node[]} children + */ constructor(type, text, children) { this.type = type; this.text = text; @@ -9,6 +15,12 @@ class Node { get mainText() { return this.children[0].text; } + get firstChild() { + return this.children[0]; + } + get lastChild() { + return this.children[this.children.length - 1]; + } } /** @@ -28,7 +40,9 @@ function nodeToObject(node) { /** * * @param {*} parseOutput - * @returns {{ name: string; def: Node;}[]} + * @typedef {{all : Set, excludes : Set}} Names + * @typedef { {types : {name:string; def : Node}[], names : Names}} Type + * @returns {Type[]} */ function getTypeDefs(parseOutput) { var rootNode = parseOutput.rootNode; @@ -38,32 +52,36 @@ function getTypeDefs(parseOutput) { // filter toplevel types has item_attribute var has_deriving_type_definitions = type_definitions.filter( (type_defintion) => { - var children = type_defintion.children; - var last = children[children.length - 1]; - var is_attribute = last.children[last.children.length - 1]; - return is_attribute.type === "item_attribute"; + // var children = type_defintion.children; + var last = type_defintion.lastChild.lastChild; + return last.type === "item_attribute"; } ); - var typedefs = has_deriving_type_definitions - .map((type_definition) => { - return type_definition.children.map((x) => { + var typedefs = has_deriving_type_definitions.map((type_definition) => { + var excludes = new Set(extractExcludes(type_definition)); + var all = new Set(type_definition.children.map((x) => x.mainText)); + return { + names: { all, excludes }, + types: type_definition.children.map((x) => { var children = x.children; - var len = children.length; + // var len = children.length; return { name: children[0].text, // we ask no type parameter redefined def: children[1], // there maybe trailing attributes // params: children.slice(0, len - 2), }; - }); - }) - .reduce((x, y) => x.concat(y)); + }), + }; + }); + // .reduce((x, y) => x.concat(y)); return typedefs; } /** - * + * @typedef { {kind : 'exclude', name : string} | { kind : 'yes', name : string} | {kind: 'no'}} Support * @param {Node} def - * @returns {string | undefined} + * @param {Names} names + * @returns {Support} * * Note visitor may have different requirements against * `to_string` where more information is appreciated @@ -72,25 +90,69 @@ function getTypeDefs(parseOutput) { * - It is an external type: M.t * - it is an foreign type : xx (xx does not belong to recursive types) */ -function isSupported(def, allNames) { +function isSupported(def, names) { + var { all: allNames, excludes } = names; if (def.children.length === 1) { - var basic = def.children[0].text; + var basic = def.mainText; if (allNames.has(basic)) { - return basic; + if (excludes.has(basic)) { + return { kind: "exclude", name: basic }; + } + return { kind: "yes", name: basic }; } - return; + return { kind: "no" }; } - return; + return { kind: "no" }; } /** * @template T - * @param {number} n - * @param {(_ : number) => T} fn + * @param {number} n + * @param {(_ : number) => T} fn * @returns {T[]} */ function init(n, fn) { return Array.from({ length: n }, (_, i) => fn(i)); } + +/** + * @param {Node} node + * @returns {string[]} + */ +function extractExcludes(node) { + try { + return node.lastChild.lastChild.children[1].children[0].children[0].children[0].children[1].children // attribute_payload // expression_item // record_expression // filed_expression + .map((x) => x.text); + } catch { + return []; + } +} +/** + * @param {(_:Type)=>string}make + * @param {Type[]} typedefs + * + */ +function maker(make, typedefs) { + return typedefs.map((x) => make(x)).reduce((x, y) => x + y); +} + +/** + * + * @param {Set} x + * @param {Set} y + * @return {string[]} + */ +function setDiff(x, y) { + var output = []; + for (let e of x) { + if (!y.has(e)) { + output.push(e); + } + } + return output; +} +exports.setDiff = setDiff; +exports.extractExcludes = extractExcludes; +exports.maker = maker; exports.init = init; exports.isSupported = isSupported; exports.getTypedefs = getTypeDefs; diff --git a/ocaml-tree/record_fold.js b/ocaml-tree/record_fold.js new file mode 100644 index 0000000000..b7e6bb7972 --- /dev/null +++ b/ocaml-tree/record_fold.js @@ -0,0 +1,221 @@ +//@ts-check +var assert = require("assert"); +var node_types = require("./node_types"); +var { init, setDiff } = node_types; +/** + * + * @typedef {import('./node_types').Node} Node + * @typedef {import("./node_types").Names} Names + * @typedef {import ("./node_types").Type} Type + * @typedef {import("./types").Obj} Obj + */ + +/** + * + * @param {{name:string, def:Node}} typedef + * @param {Names} allNames + * @returns {string} + */ +function mkMethod({ name, def }, allNames) { + return `let ${name} : 'a . ('a,${name}) fn = ${mkBody(def, allNames)} `; +} + +var skip = `unknown`; + +/** + * @param {Node} def + * @param {Names} 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 st { ${pat_exp.join(";")}} -> ${body.join(" ")} st`; + case "variant_declaration": + var len = def.children.length; + var branches = def.children.map((branch) => mkBranch(branch, allNames)); + return `fun _self st -> function \n| ${branches.join("\n|")}`; + default: + throw new Error(`unkonwn ${def.type}`); + } +} + +/** + * @type {Obj} + */ +var skip_obj = { + eta: skip, + beta(x) { + return `${skip} ${x}`; + }, +}; + +/** + * + * + * @param {Node} def + * @param {Names} allNames + * The code fragments should have two operations + * - eta-expanded + * needed due to `self` is missing + * @returns {Obj} + */ +function mkStructuralTy(def, allNames) { + switch (def.type) { + case "type_constructor_path": + var basic = node_types.isSupported(def, allNames); + switch (basic.kind) { + case "no": + return skip_obj; + case "exclude": + case "yes": + var code = + basic.kind === "yes" ? `_self.${basic.name}` : `${basic.name}`; + return { + eta: `(fun _self arg -> ${code} _self arg)`, + beta(x) { + return `let st = ${code} _self st ${x} in`; + }, + method: code, + }; + } + 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})`; + var inner_code = inner.method; + if (inner_code === undefined) { + inner_code = `(${inner.eta})`; + } + return { + eta: `fun _self st arg -> ${list.text} ${inner_code} _self st arg`, + beta(x) { + return `let st = ${list.text} ${inner_code} _self st ${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(",")}) -> ${body.join(" ")} st `; + return { + eta: `(fun _self st ${snippet})`, + beta(x) { + // This code path seems to be not hit + return `let st = (fun ${snippet}) ${x} in `; + }, + }; + default: + throw new Error(`unsupported structural type ${def.type}`); + } +} +/** + * + * @param {Node} ty + * @param {Names} 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 {Names} 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} -> st`; + } + 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} _ -> st`; + } + return `${pat_exp} -> \n ${body.join(" ")} st`; +} + +/** + * @param {Type} type + * @returns {string} + */ +function make(type) { + var { types: typedefs, names } = type; + var customNames = setDiff(names.all, names.excludes); + var output = typedefs.map((x) => mkMethod(x, names)); + var o = ` +open J +let [@inline] unknown _ st _ = st +let [@inline] option sub self st = fun v -> + match v with + | None -> st + | Some v -> sub self st v +let rec list sub self st = fun x -> + match x with + | [] -> st + | x::xs -> + let st = sub self st x in + list sub self st xs + +type 'state iter = { +${customNames.map((x) => ` ${x} : ('state,${x}) fn`).join(";\n")} +} +and ('state,'a) fn = 'state iter -> 'state -> 'a -> 'state +${output.join("\n")} +let super : 'state iter = { +${customNames.map((x) => ` ${x}`).join(";\n")} +} + `; + return o; +} +exports.make = make; diff --git a/ocaml-tree/record_iter.js b/ocaml-tree/record_iter.js index 57de5136dc..0696a13cb0 100644 --- a/ocaml-tree/record_iter.js +++ b/ocaml-tree/record_iter.js @@ -1,27 +1,30 @@ //@ts-check var assert = require("assert"); var node_types = require("./node_types"); -var init = node_types.init; +var { init, setDiff } = node_types; /** * * @typedef {import('./node_types').Node} Node + * @typedef {import("./node_types").Names} Names + * @typedef {import ("./node_types").Type} Type + * @typedef {import("./types").Obj} Obj */ /** * * @param {{name:string, def:Node}} typedef - * @param {Set} allNames + * @param {Names} allNames * @returns {string} */ function mkMethod({ name, def }, allNames) { - return ` ${name} : ${name} fn = ( ${mkBody(def, allNames)} ) `; + return `let ${name} : ${name} fn = ${mkBody(def, allNames)} `; } var skip = `unknown`; /** * @param {Node} def - * @param {Set} allNames + * @param {Names} allNames */ function mkBody(def, allNames) { // @ts-ignore @@ -56,20 +59,12 @@ function mkBody(def, allNames) { throw new Error(`unkonwn ${def.type}`); } } -/** - * @typedef { { eta: string; beta(x: string): string; method? : string } } Obj - * - */ /** * @type {Obj} */ var skip_obj = { eta: skip, - /** - * - * @param {string} x - */ beta(x) { return `${skip} ${x}`; }, @@ -79,7 +74,7 @@ var skip_obj = { * * * @param {Node} def - * @param {Set} allNames + * @param {Names} allNames * The code fragments should have two operations * - eta-expanded * needed due to `self` is missing @@ -89,17 +84,21 @@ 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}`; - }, - method: code, - }; + switch (basic.kind) { + case "no": + return skip_obj; + case "exclude": + case "yes": + var code = + basic.kind === "yes" ? `_self.${basic.name}` : `${basic.name}`; + return { + eta: `(fun _self arg -> ${code} _self arg)`, + beta(x) { + return `${code} _self ${x}`; + }, + method: code, + }; } - return skip_obj; case "constructed_type": // FIXME var [list, base] = [...def.children].reverse(); @@ -144,7 +143,7 @@ function mkStructuralTy(def, allNames) { /** * * @param {Node} ty - * @param {Set} allNames + * @param {Names} allNames * @param {string} arg */ function mkBodyApply(ty, allNames, arg) { @@ -159,7 +158,7 @@ function mkBodyApply(ty, allNames, arg) { * * @param {Node} branch * branch is constructor_declaration - * @param {Set} allNames + * @param {Names} allNames * @returns {string} */ function mkBranch(branch, allNames) { @@ -186,34 +185,34 @@ function mkBranch(branch, allNames) { } /** - * - * @param {{name : string, def: Node}[]} typedefs + * @param {Type} type * @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)); +function make(type) { + var { types: typedefs, names } = type; + var customNames = setDiff(names.all, names.excludes); + var output = typedefs.map((x) => mkMethod(x, names)); var o = ` - open J - let unknown _ _ = () - let [@inline] 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 +open J +let unknown _ _ = () +let [@inline] 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 super : iter = { - ${output.join(";\n")} +type iter = { +${customNames.map((x) => `${x} : ${x} fn`).join(";\n")} +} +and 'a fn = iter -> 'a -> unit +${output.join("\n")} +let super : iter = { +${customNames.join(";\n")} } `; return o; diff --git a/ocaml-tree/record_map.js b/ocaml-tree/record_map.js index 62201ce547..8b22d800a4 100644 --- a/ocaml-tree/record_map.js +++ b/ocaml-tree/record_map.js @@ -1,27 +1,30 @@ //@ts-check var assert = require("assert"); var node_types = require("./node_types"); -var init = node_types.init; +var { init, setDiff } = node_types; /** * * @typedef {import('./node_types').Node} Node + * @typedef {import("./node_types").Names} Names + * @typedef {import ("./node_types").Type} Type + * @typedef {import("./types").Obj} Obj */ /** * * @param {{name:string, def:Node}} typedef - * @param {Set} allNames + * @param {Names} allNames * @returns {string} */ function mkMethod({ name, def }, allNames) { - return ` ${name} : ${name} fn = ( ${mkBody(def, allNames)} ) `; + return ` let ${name} : ${name} fn = ${mkBody(def, allNames)} `; } var skip = `unknown`; /** * @param {Node} def - * @param {Set} allNames + * @param {Names} allNames */ function mkBody(def, allNames) { // @ts-ignore @@ -59,20 +62,11 @@ function mkBody(def, allNames) { } } -/** - * @typedef { { eta: string; beta(x: string): string; method? : string } } Obj - * - */ - /** * @type {Obj} */ var skip_obj = { eta: skip, - /** - * - * @param {string} x - */ beta(x) { return `${skip} ${x}`; }, @@ -82,7 +76,7 @@ var skip_obj = { * * * @param {Node} def - * @param {Set} allNames + * @param {Names} allNames * The code fragments should have two operations * - eta-expanded * needed due to `self` is missing @@ -92,17 +86,22 @@ 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 `; - }, - method: code, - }; + switch (basic.kind) { + case "no": + return skip_obj; + case "exclude": + case "yes": + var code = + basic.kind === "yes" ? `_self.${basic.name}` : `${basic.name}`; + return { + eta: `(fun _self arg -> ${code} _self arg)`, + beta(x) { + return `let ${x} = ${code} _self ${x} in `; + }, + method: code, + }; } - return skip_obj; + case "constructed_type": // FIXME var [list, base] = [...def.children].reverse(); @@ -149,7 +148,7 @@ function mkStructuralTy(def, allNames) { /** * * @param {Node} ty - * @param {Set} allNames + * @param {Names} allNames * @param {string} arg */ function mkBodyApply(ty, allNames, arg) { @@ -164,7 +163,7 @@ function mkBodyApply(ty, allNames, arg) { * * @param {Node} branch * branch is constructor_declaration - * @param {Set} allNames + * @param {Names} allNames * @returns {string} */ function mkBranch(branch, allNames) { @@ -192,35 +191,36 @@ function mkBranch(branch, allNames) { /** * - * @param {{name : string, def: Node}[]} typedefs + * @param {Type} type * @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)); +function make(type) { + var { types: typedefs, names } = type; + var customNames = setDiff(names.all, names.excludes); + var output = typedefs.map((x) => mkMethod(x, names)); var o = ` - open J - let [@inline] unknown _ x = x - let [@inline] 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 +open J +let [@inline] unknown _ x = x +let [@inline] 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")} - } - `; +type iter = { +${customNames.map((x) => `${x} : ${x} fn`).join(";\n")} +} +and 'a fn = iter -> 'a -> 'a +${output.join("\n")} +let super : iter = { +${customNames.join(";\n")} +} +`; return o; } exports.make = make; diff --git a/ocaml-tree/test.js b/ocaml-tree/test.js index 6849037898..7ccd3b7a6a 100644 --- a/ocaml-tree/test.js +++ b/ocaml-tree/test.js @@ -6,8 +6,8 @@ OCaml.nodeTypeInfo = require("./src/node-types.json"); var P = require("tree-sitter"); var p = new P(); p.setLanguage(OCaml); - -var { Node, getTypedefs, nodeToObject } = require("./node_types.js"); +var nodeTypes = require("./node_types.js"); +var { Node, getTypedefs, nodeToObject, maker } = nodeTypes; // https://docs.google.com/document/d/1FTascZXT9cxfetuPRT2eXPQKXui4nWFivUnS_335T3U/preview var nodeFormatter = { @@ -62,14 +62,15 @@ 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); +// var map_maker = require("./map_maker"); +// var fold_maker = require("./fold_maker"); +// var iter_maker = require("./iter_maker"); +// var fold = maker(fold_maker.make,typedefs); +// var map = maker(map_maker.make,typedefs); +// var iter = maker(iter_maker.make,typedefs); +// var record_iter = require("./record_iter"); +var record_fold = require("./record_fold"); +// var record_map = require("./record_map"); +var riter = maker(record_fold.make, typedefs); // console.log(fold, map); -fs.writeFileSync(path.join(j_dir, "js_record_map.ml"), riter, "utf8"); +fs.writeFileSync(path.join(j_dir, "js_record_fold.ml"), riter, "utf8"); diff --git a/ocaml-tree/types.d.ts b/ocaml-tree/types.d.ts new file mode 100644 index 0000000000..c433e0b71a --- /dev/null +++ b/ocaml-tree/types.d.ts @@ -0,0 +1,7 @@ + + +export interface Obj { + eta : string + beta : (x : string) => string + method? : string +} \ No newline at end of file diff --git a/ocaml-tree/wasm.js b/ocaml-tree/wasm.js index e6179d0732..02031c82fc 100644 --- a/ocaml-tree/wasm.js +++ b/ocaml-tree/wasm.js @@ -10,21 +10,18 @@ var mode = "map"; for (let i = 0; i < process.argv.length; ++i) { let u = process.argv[i]; switch (u) { - case "-map": - mode = "map"; - break; case "-fold": mode = "fold"; break; - case "-iter": - mode = "iter"; - break; case "-record-iter": mode = "record-iter"; break; case "-record-map": mode = "record-map"; break; + case "-record-fold": + mode = "record-fold"; + break; case "-i": ++i; input = process.argv[i]; @@ -37,11 +34,13 @@ for (let i = 0; i < process.argv.length; ++i) { } var source = fs.readFileSync(input, "utf8"); var node_types = require("./node_types"); -var map_maker = require("./map_maker"); + var fold_maker = require("./fold_maker"); -var iter_maker = require("./iter_maker"); var record_iter = require("./record_iter"); var record_map = require("./record_map"); +var record_fold = require("./record_fold"); +var maker = node_types.maker; + // var p = new P() (async () => { await P.init(); @@ -51,20 +50,17 @@ var record_map = require("./record_map"); var out = p.parse(source); var typedefs = node_types.getTypedefs(out); switch (mode) { - case "map": - fs.writeFileSync(output, map_maker.make(typedefs), "utf8"); - break; case "fold": - fs.writeFileSync(output, fold_maker.make(typedefs), "utf8"); + fs.writeFileSync(output, maker(fold_maker.make, typedefs), "utf8"); break; - case "iter": - fs.writeFileSync(output, iter_maker.make(typedefs), "utf8"); + case "record-fold": + fs.writeFileSync(output, maker(record_fold.make, typedefs), "utf8"); break; case "record-iter": - fs.writeFileSync(output, record_iter.make(typedefs), "utf8"); + fs.writeFileSync(output, maker(record_iter.make, typedefs), "utf8"); break; case "record-map": - fs.writeFileSync(output, record_map.make(typedefs), "utf8"); + fs.writeFileSync(output, maker(record_map.make, typedefs), "utf8"); break; } })(); diff --git a/scripts/ninja.js b/scripts/ninja.js index cf223a1ba9..eab0d693e3 100755 --- a/scripts/ninja.js +++ b/scripts/ninja.js @@ -1547,7 +1547,7 @@ function nativeNinja() { subninja ${getPreprocessorFileName()} compilerlibs := ../native/4.06.1/lib/ocaml/compiler-libs/ocamlcommon.cmxa rule optc - command = $ocamlopt -safe-string -I +compiler-libs -opaque ${includes} -g -linscan -w A-4-9-40..42-30-48-50 -warn-error A -absname -c $in # $compilerlibs + command = $ocamlopt -strict-sequence -safe-string -I +compiler-libs -opaque ${includes} -g -linscan -w A-4-9-40..42-30-48-50 -warn-error A -absname -c $in # $compilerlibs description = $out : $in rule archive command = $ocamlopt -a $in -o $out @@ -1582,15 +1582,12 @@ rule p4of generator = true o core/js_fold.ml: p4of core/j.ml flags = -fold -o core/js_map.ml: p4of core/j.ml - flags = -map -o core/js_iter.ml: p4of core/j.ml - flags = -iter o core/js_record_iter.ml: p4of core/j.ml flags = -record-iter o core/js_record_map.ml: p4of core/j.ml flags = -record-map - +o core/js_record_fold.ml: p4of core/j.ml + flags = -record-fold o common/bs_version.ml : mk_bsversion build_version.js ../package.json o ../${