Merge pull request #4916 from rescript-lang/simpilify_visitor2

Finish the optimization around visitor pattern using objects

Author: bobzhang

jscomp/core/js_analyzer.ml

@@ -44,47 +44,51 @@ let add_defined_idents (x : idents_stats) ident =
    Note such shaking is done in the toplevel, so that it requires us to 
    flatten the statement first 
 *)
-let free_variables (stats : idents_stats) : Js_iter.iter = 
-  object (self)
-    inherit Js_iter.iter as super
-    method! variable_declaration st = 
-      add_defined_idents stats st.ident; 
-      match st.value with 
-      |  None
-        ->  ()
-      | Some v
-        -> 
-        self # expression v
-    method! ident id = 
-      (if not (Set_ident.mem stats.defined_idents id )then 
-         stats.used_idents <- Set_ident.add stats.used_idents id)
-
-    method! expression exp = 
-      match exp.expression_desc with
-      | Fun(_, _,_, env)
-        (** a optimization to avoid walking into funciton again
-            if it's already comuted
-        *)
-        ->
-        stats.used_idents <-
-          Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents
+let super = Js_record_iter.iter
+let free_variables (stats : idents_stats) = {
+  super with 
+  variable_declaration = begin fun self st ->   
+    add_defined_idents stats st.ident; 
+    match st.value with 
+    |  None
+      ->  ()
+    | Some v
+      -> 
+      self.expression self v
 
+  end;
+  ident = begin fun _ id -> 
+    if not (Set_ident.mem stats.defined_idents id )then 
+      stats.used_idents <- Set_ident.add stats.used_idents id
+  end;
+  expression = begin fun self exp -> 
+    match exp.expression_desc with
+    | Fun(_, _,_, env)
+      (** a optimization to avoid walking into funciton again
+          if it's already comuted
+      *)
+      ->
+      stats.used_idents <-
+        Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents
+    | _
+      ->
+      super.expression self exp
+  end
+}
 
-      | _
-        ->
-        super#expression exp
-  end 
 
 let free_variables_of_statement  st = 
   let init = {used_idents = Set_ident.empty;  
-              defined_idents = Set_ident.empty} in 
-  let _ = (free_variables init)#statement st in 
+              defined_idents = Set_ident.empty} in
+  let obj = free_variables init in               
+  obj.statement obj st ;
   Set_ident.diff init.used_idents init.defined_idents
 
 let free_variables_of_expression  st = 
   let init = {used_idents = Set_ident.empty;  
               defined_idents = Set_ident.empty} in 
-  let _ = (free_variables init)#expression st in 
+  let obj = free_variables init in 
+  obj.expression obj st ;
   Set_ident.diff init.used_idents init.defined_idents
 
 let rec no_side_effect_expression_desc (x : J.expression_desc)  = 
@@ -139,32 +143,28 @@ and no_side_effect (x : J.expression)  =
 
 let no_side_effect_expression (x : J.expression) = no_side_effect x 
 
-let no_side_effect clean : Js_iter.iter = 
-  object (self)
-    inherit Js_iter.iter as super
-    method! statement s = 
-      if !clean then 
+let super = Js_record_iter.iter 
+let no_side_effect_obj  = 
+  {super with 
+    statement = (fun self s -> 
         match s.statement_desc with 
         | Throw _ 
         | Debugger 
         | Break 
         | Variable _ 
         | Continue _ ->  
-          clean := false 
-        | Exp e -> self#expression e 
+          raise_notrace Not_found
+        | Exp e -> self.expression self e 
         | Int_switch _ | String_switch _ | ForRange _ 
-        | If _ | While _   | Block _ | Return _ | Try _  -> super#statement s 
-    method! list f x = 
-      if  !clean then super#list f x 
-    method! expression s = 
-      if !clean then 
-        clean := no_side_effect_expression s      
-        (** only expression would cause side effec *)
-  end
+        | If _ | While _   | Block _ | Return _ | Try _  -> super.statement self s );
+    expression = begin fun _ s ->  
+      if not (no_side_effect_expression s) then raise_notrace Not_found
+  end}
 let no_side_effect_statement st = 
-  let clean = ref true in   
-  (no_side_effect clean)#statement st;
-  !clean
+  try 
+    no_side_effect_obj.statement no_side_effect_obj st; true
+  with _ -> false
+
 
 (* TODO: generate [fold2] 
    This make sense, for example:

jscomp/core/js_fold.ml

@@ -1,19 +1,26 @@
 
     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 option :
-          'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type =
-          fun _f_a -> function | None -> _self | Some _x -> let _self = _f_a _self _x in _self
         method list :
           'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type =
           fun _f_a ->
             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 = _self#list (fun _self -> _self#module_id)  
+method required_modules : required_modules -> 'self_type = list (fun _self -> _self#module_id) _self  
 method ident : ident -> 'self_type = unknown _self  
 method module_id : module_id -> 'self_type = fun { id = _x0;kind = _x1} -> let _self = _self#ident _x0 in _self  
 method vident : vident -> 'self_type = function 
@@ -22,12 +29,11 @@ let _self = _self#ident _x0 in
  _self
 |Qualified ( _x0,_x1)  -> 
 let _self = _self#module_id _x0 in
-let _self = _self#option (fun _self -> unknown _self) _x1 in
  _self  
 method exception_ident : exception_ident -> 'self_type = _self#ident  
 method for_ident : for_ident -> 'self_type = _self#ident  
 method for_direction : for_direction -> 'self_type = unknown _self  
-method property_map : property_map -> 'self_type = _self#list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self)  
+method property_map : property_map -> 'self_type = list (fun _self -> fun ( _x0,_x1) -> let _self = _self#expression _x1 in _self) _self  
 method length_object : length_object -> 'self_type = unknown _self  
 method expression_desc : expression_desc -> 'self_type = function 
 | Length ( _x0,_x1)  -> 
@@ -73,7 +79,7 @@ let _self = _self#expression _x1 in
  _self
 |Call ( _x0,_x1,_x2)  -> 
 let _self = _self#expression _x0 in
-let _self = _self#list (fun _self -> _self#expression) _x1 in
+let _self = list (fun _self -> _self#expression) _self _x1 in
  _self
 |String_index ( _x0,_x1)  -> 
 let _self = _self#expression _x0 in
@@ -85,30 +91,29 @@ let _self = _self#expression _x1 in
  _self
 |Static_index ( _x0,_x1,_x2)  -> 
 let _self = _self#expression _x0 in
-let _self = _self#option (fun _self -> unknown _self) _x2 in
  _self
 |New ( _x0,_x1)  -> 
 let _self = _self#expression _x0 in
-let _self = _self#option (fun _self -> _self#list (fun _self -> _self#expression)) _x1 in
+let _self = option (fun _self -> list (fun _self -> _self#expression) _self) _self _x1 in
  _self
 |Var ( _x0)  -> 
 let _self = _self#vident _x0 in
  _self
 |Fun ( _x0,_x1,_x2,_x3)  -> 
-let _self = _self#list (fun _self -> _self#ident) _x1 in
+let _self = list (fun _self -> _self#ident) _self _x1 in
 let _self = _self#block _x2 in
  _self
 |Str _ -> _self
 |Unicode _ -> _self
 |Raw_js_code _ -> _self
 |Array ( _x0,_x1)  -> 
-let _self = _self#list (fun _self -> _self#expression) _x0 in
+let _self = list (fun _self -> _self#expression) _self _x0 in
  _self
 |Optional_block ( _x0,_x1)  -> 
 let _self = _self#expression _x0 in
  _self
 |Caml_block ( _x0,_x1,_x2,_x3)  -> 
-let _self = _self#list (fun _self -> _self#expression) _x0 in
+let _self = list (fun _self -> _self#expression) _self _x0 in
 let _self = _self#expression _x2 in
  _self
 |Caml_block_tag ( _x0)  -> 
@@ -138,12 +143,12 @@ let _self = _self#block _x1 in
 let _self = _self#block _x2 in
  _self
 |While ( _x0,_x1,_x2,_x3)  -> 
-let _self = _self#option (fun _self -> _self#label) _x0 in
+let _self = option (fun _self -> _self#label) _self _x0 in
 let _self = _self#expression _x1 in
 let _self = _self#block _x2 in
  _self
 |ForRange ( _x0,_x1,_x2,_x3,_x4,_x5)  -> 
-let _self = _self#option (fun _self -> _self#for_ident_expression) _x0 in
+let _self = option (fun _self -> _self#for_ident_expression) _self _x0 in
 let _self = _self#finish_ident_expression _x1 in
 let _self = _self#for_ident _x2 in
 let _self = _self#for_direction _x3 in
@@ -158,37 +163,33 @@ let _self = _self#expression _x0 in
  _self
 |Int_switch ( _x0,_x1,_x2)  -> 
 let _self = _self#expression _x0 in
-let _self = _self#list (fun _self -> _self#int_clause) _x1 in
-let _self = _self#option (fun _self -> _self#block) _x2 in
+let _self = list (fun _self -> _self#int_clause) _self _x1 in
+let _self = option (fun _self -> _self#block) _self _x2 in
  _self
 |String_switch ( _x0,_x1,_x2)  -> 
 let _self = _self#expression _x0 in
-let _self = _self#list (fun _self -> _self#string_clause) _x1 in
-let _self = _self#option (fun _self -> _self#block) _x2 in
+let _self = list (fun _self -> _self#string_clause) _self _x1 in
+let _self = option (fun _self -> _self#block) _self _x2 in
  _self
 |Throw ( _x0)  -> 
 let _self = _self#expression _x0 in
  _self
 |Try ( _x0,_x1,_x2)  -> 
 let _self = _self#block _x0 in
-let _self = _self#option (fun _self -> fun ( _x0,_x1) -> let _self = _self#exception_ident _x0 in let _self = _self#block _x1 in _self) _x1 in
-let _self = _self#option (fun _self -> _self#block) _x2 in
+let _self = option (fun _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
-let _self = _self#option (fun _self -> unknown _self) _x1 in _self  
-method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in
-let _self = _self#option (fun _self -> unknown _self) _x1 in _self  
+method expression : expression -> 'self_type = fun { expression_desc = _x0;comment = _x1} -> let _self = _self#expression_desc _x0 in _self  
+method statement : statement -> 'self_type = fun { statement_desc = _x0;comment = _x1} -> let _self = _self#statement_desc _x0 in _self  
 method variable_declaration : variable_declaration -> 'self_type = fun { ident = _x0;value = _x1;property = _x2;ident_info = _x3} -> let _self = _self#ident _x0 in
-let _self = _self#option (fun _self -> _self#expression) _x1 in _self  
+let _self = option (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
-let _self = _self#option (fun _self -> unknown _self) _x2 in _self  
-method block : block -> 'self_type = _self#list (fun _self -> _self#statement)  
+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
-let _self = _self#option (fun _self -> unknown _self) _x2 in _self      
+let _self = _self#required_modules _x1 in _self      
     end
 

jscomp/core/js_fold_basic.ml

@@ -27,25 +27,30 @@
 
 let add_lam_module_ident = Lam_module_ident.Hash_set.add
 let create = Lam_module_ident.Hash_set.create
-let count_hard_dependencies hard_dependencies = 
-  object
-    inherit  Js_iter.iter as super
-    method! module_id vid = 
-        add_lam_module_ident  hard_dependencies vid
-    method! expression x   = 
-      (* check {!Js_pass_scope} when making changes *)
+
+let super = Js_record_iter.iter 
+let  count_hard_dependencies hard_dependencies = {
+  super with 
+  module_id = begin 
+    fun _ vid -> 
+      add_lam_module_ident hard_dependencies vid
+  end;
+  expression = begin 
+    fun self x ->   
       (match  Js_block_runtime.check_additional_id x with
        | Some id -> 
          add_lam_module_ident hard_dependencies
            (Lam_module_ident.of_runtime 
               id)
        | _ -> ());
-      super#expression x
-  end
+      super.expression self x
+  end    
+}
 
 let calculate_hard_dependencies block = 
   let hard_dependencies = create 17 in   
-  (count_hard_dependencies hard_dependencies)#block block ;
+  let obj = (count_hard_dependencies hard_dependencies) in 
+  obj.block obj block ;
   hard_dependencies
 
 (*