Clean up lambda.

Author: cristianoc

jscomp/core/lam.ml

@@ -33,12 +33,13 @@ type apply_status =
 module Types = struct
   type switch_names = {consts: string array; blocks: string array}
 
-  type switch =
+  type lambda_switch =
     { sw_numconsts: bool; (* TODO: refine its representation *)
       sw_consts: (int * t) list;
       sw_numblocks: bool;
       sw_blocks: (int * t) list;
-      sw_failaction : t option}
+      sw_failaction : t option;
+      sw_names : switch_names option }
   (* 
     Invariant: 
     length (sw_consts) <= sw_numconsts 
@@ -94,7 +95,7 @@ module Types = struct
     | Llet of Lam_compat.let_kind * ident * t * t
     | Lletrec of (ident * t) list * t
     | Lprim of prim_info
-    | Lswitch of t * switch * switch_names option
+    | Lswitch of t * lambda_switch
     | Lstringswitch of t * (string * t) list * t option
     | Lstaticraise of int * t list
     | Lstaticcatch of t * (int * ident list) * t
@@ -110,14 +111,15 @@ end
 module X = struct
   type switch_names = Types.switch_names = {consts: string array; blocks: string array}
 
-  type switch
-    = Types.switch
+  type lambda_switch
+    = Types.lambda_switch
     =
       { sw_numconsts: bool;
         sw_consts: (int * t) list;
         sw_numblocks: bool;
         sw_blocks: (int * t) list;
-        sw_failaction : t option}
+        sw_failaction: t option;
+        sw_names: switch_names option }
   and prim_info
     =  Types.prim_info
     =
@@ -152,7 +154,7 @@ module X = struct
       | Llet of Lam_compat.let_kind * ident * t * t
       | Lletrec of (ident * t) list * t
       | Lprim of prim_info
-      | Lswitch of t * switch * switch_names option
+      | Lswitch of t * lambda_switch
       | Lstringswitch of t * (string * t) list * t option
       | Lstaticraise of int * t list
       | Lstaticcatch of t * (int * ident list) * t
@@ -196,12 +198,12 @@ let inner_map
     let args = Ext_list.map args f in
     Lprim { args; primitive; loc}
 
-  | Lswitch(arg, {sw_consts; sw_numconsts; sw_blocks; sw_numblocks; sw_failaction}, names) ->
+  | Lswitch(arg, {sw_consts; sw_numconsts; sw_blocks; sw_numblocks; sw_failaction; sw_names}) ->
     let arg = f arg in
     let sw_consts = Ext_list.map_snd  sw_consts f in
     let sw_blocks = Ext_list.map_snd  sw_blocks f in
     let sw_failaction = Ext_option.map sw_failaction f in
-    Lswitch(arg, { sw_consts; sw_blocks; sw_failaction; sw_numblocks; sw_numconsts}, names)
+    Lswitch(arg, { sw_consts; sw_blocks; sw_failaction; sw_numblocks; sw_numconsts; sw_names})
   | Lstringswitch (arg,cases,default) ->
     let arg = f arg  in
     let cases = Ext_list.map_snd  cases f in
@@ -386,15 +388,15 @@ and eq_approx_list ls ls1 =  Ext_list.for_all2_no_exn ls ls1 eq_approx
 
 
 
-let switch lam (lam_switch : switch) names : t =
+let switch lam (lam_switch : lambda_switch) : t =
   match lam with
   | Lconst ((Const_pointer (i,_) |  (Const_int i)))
     ->
     Ext_list.assoc_by_int   lam_switch.sw_consts i lam_switch.sw_failaction
   | Lconst (Const_block (i,_,_)) ->
     Ext_list.assoc_by_int lam_switch.sw_blocks i lam_switch.sw_failaction 
   | _ ->
-    Lswitch(lam,lam_switch,names)
+    Lswitch(lam,lam_switch)
 
 let stringswitch (lam : t) cases default : t =
   match lam with
@@ -731,15 +733,13 @@ let if_ (a : t) (b : t) (c : t) : t =
          begin match c with 
            | Lswitch ( Lvar yy as switch_arg, 
                        ({sw_blocks = []; sw_numblocks = true; sw_consts ;
-                         sw_numconsts; sw_failaction = None} as body),
-                       names
+                         sw_numconsts; sw_failaction = None; sw_names; } as body)
                      )
              when Ident.same xx yy 
                && complete_range sw_consts ~start:0 ~finish:range
              ->  
              Lswitch(switch_arg, 
-                     { body with sw_failaction = Some b; sw_numconsts = false },
-                     names)
+                     { body with sw_failaction = Some b; sw_numconsts = false; sw_names; })
            |  _ -> Lifthenelse(a,b,c)      
          end
        | _ ->  Lifthenelse (a,b,c))

jscomp/core/lam.mli

@@ -30,12 +30,13 @@ type ident = Ident.t
 
 type switch_names = {consts: string array; blocks: string array}
 
-type switch  =
+type lambda_switch  =
   { sw_numconsts: bool;
     sw_consts: (int * t) list;
     sw_numblocks: bool;
     sw_blocks: (int * t) list;
-    sw_failaction : t option}
+    sw_failaction: t option;
+    sw_names: switch_names option }
 and apply_status =
   | App_na
   | App_ml_full
@@ -66,7 +67,7 @@ and  t =  private
   | Llet of Lam_compat.let_kind * ident * t * t
   | Lletrec of (ident * t) list * t
   | Lprim of prim_info
-  | Lswitch of t * switch * switch_names option
+  | Lswitch of t * lambda_switch
   | Lstringswitch of t * (string * t) list * t option
   | Lstaticraise of int * t list
   | Lstaticcatch of t * (int * ident list) * t
@@ -116,7 +117,7 @@ val letrec : (ident * t) list -> t -> t
 val if_ : t -> t -> t -> t 
 
 (** constant folding*)
-val switch : t -> switch -> switch_names option -> t 
+val switch : t -> lambda_switch -> t 
 (** constant folding*)
 val stringswitch : t -> (string * t) list -> t option -> t 
 

jscomp/core/lam_analysis.ml

@@ -361,11 +361,11 @@ let destruct_pattern (body : Lam.t) params args =
     | x::xs, [] -> assert false                  
   in   
   match body with
-  | Lswitch (Lvar v , switch, names)
+  | Lswitch (Lvar v , switch)
     ->
     begin match aux v params args with
       | Some (Lam.Lconst _ as lam) ->
-        size (Lam.switch lam switch names) < small_inline_size
+        size (Lam.switch lam switch) < small_inline_size
       | Some _ | None -> false
     end        
   | Lifthenelse(Lvar v, then_, else_)

jscomp/core/lam_arity_analysis.ml

@@ -110,7 +110,7 @@ let rec get_arity (meta : Lam_stats.t) (lam : Lam.t) :  Lam_arity.t =
                 sw_blocks;
                 sw_numblocks = _;
                 sw_numconsts = _;
-               }, _names) -> 
+               }) -> 
     all_lambdas meta (
       let rest = 
         Ext_list.map_append sw_consts

jscomp/core/lam_bounded_vars.ml

@@ -120,17 +120,18 @@ let rewrite (map :   _ Ident_hashtbl.t)
                   sw_blocks;
                   sw_numblocks;
                   sw_numconsts;
-                 }, names) ->
+                  sw_names;
+                 }) ->
       let l = aux l in
       Lam.switch l
               {sw_consts = 
                  Ext_list.map_snd  sw_consts aux;
                sw_blocks = Ext_list.map_snd  sw_blocks aux;
                sw_numconsts = sw_numconsts;
                sw_numblocks = sw_numblocks;
-               sw_failaction =  option_map sw_failaction
+               sw_failaction = option_map sw_failaction;
+               sw_names;
               }
-              names
     | Lstringswitch(l, sw, d) ->
       let l = aux  l in
       Lam.stringswitch l 

jscomp/core/lam_check.ml

@@ -74,7 +74,7 @@ let check file lam =
       | Lletrec(decl, body) ->
         check_list_snd  decl cxt;
         check_staticfails body cxt
-      | Lswitch(arg, sw, _names) ->
+      | Lswitch(arg, sw) ->
         check_staticfails arg cxt ;
         check_list_snd sw.sw_consts cxt;
         check_list_snd sw.sw_blocks cxt;
@@ -127,7 +127,7 @@ let check file lam =
         iter_list_snd  decl;
         iter body
 
-      | Lswitch(arg, sw, _names) ->
+      | Lswitch(arg, sw) ->
         iter arg;
         iter_list_snd sw.sw_consts;
         iter_list_snd sw.sw_blocks;

jscomp/core/lam_closure.ml

@@ -104,7 +104,7 @@ let free_variables
                 sw_failaction;
                 sw_numconsts;
                 sw_numblocks
-               }), _names) ->
+               })) ->
       iter top arg; 
       let top = Lam_var_stats.new_position_after_lam arg top  in       
       List.iter (fun (_, case) -> iter top case) sw_consts;

jscomp/core/lam_compile.ml

@@ -515,16 +515,16 @@ and compile_general_cases
           [switch ?default ?declaration switch_exp body]
         )
 
-and compile_cases ~is_tag cxt switch_exp table default names =
+and compile_cases ~is_tag cxt switch_exp table default sw_names =
   compile_general_cases
     (fun i ->
-      match names with
+      match sw_names with
       | None -> None
       | Some {Lam.blocks; consts} ->
         Some (if is_tag then blocks.(i) else consts.(i)))
     (fun i ->
       let comment = 
-        match names with
+        match sw_names with
         | None -> None
         | Some {Lam.blocks; consts} ->
           Some (if is_tag then blocks.(i) else consts.(i)) in
@@ -536,7 +536,7 @@ and compile_cases ~is_tag cxt switch_exp table default names =
     switch_exp
     table
     default
-and compile_switch switch_arg sw (lambda_cxt : Lam_compile_context.t) (names : Lam.switch_names option) = 
+and compile_switch switch_arg sw (lambda_cxt : Lam_compile_context.t) = 
   (* TODO: if default is None, we can do some optimizations
       Use switch vs if/then/else
 
@@ -548,7 +548,8 @@ and compile_switch switch_arg sw (lambda_cxt : Lam_compile_context.t) (names : L
         sw_consts;
         sw_numblocks;
         sw_blocks;
-        sw_failaction } : Lam.switch) = sw in 
+        sw_failaction;
+        sw_names } : Lam.lambda_switch) = sw in 
   let  sw_num_default  =
     match sw_failaction with
     | None -> Complete
@@ -572,20 +573,20 @@ and compile_switch switch_arg sw (lambda_cxt : Lam_compile_context.t) (names : L
     | { block; value = Some e } ->
       block @
       (if sw_numconsts && sw_consts = [] then
-         compile_cases ~is_tag:true cxt (E.tag e)  sw_blocks sw_blocks_default names
+         compile_cases ~is_tag:true cxt (E.tag e)  sw_blocks sw_blocks_default sw_names
        else if sw_numblocks && sw_blocks = [] then
-         compile_cases ~is_tag:false cxt e  sw_consts sw_num_default names
+         compile_cases ~is_tag:false cxt e  sw_consts sw_num_default sw_names
        else
          (* [e] will be used twice  *)
          let dispatch e =
            S.if_
              (E.is_type_number e )
-             (compile_cases ~is_tag:false cxt e sw_consts sw_num_default names
+             (compile_cases ~is_tag:false cxt e sw_consts sw_num_default sw_names
              )
              (* default still needed, could simplified*)
              ~else_:
                (compile_cases ~is_tag:true cxt (E.tag e ) sw_blocks
-                  sw_blocks_default names) in
+                  sw_blocks_default sw_names) in
            match e.expression_desc with
            | J.Var _  -> [ dispatch e]
            | _ ->
@@ -1602,11 +1603,8 @@ and compile_lambda
       compile_ifthenelse predicate t_branch f_branch lambda_cxt  
     | Lstringswitch(l, cases, default) ->
       compile_stringswitch l cases default lambda_cxt
-    | Lswitch(switch_arg, sw, names) ->
-      (* Format.eprintf "XXX Lswitch consts:%d blocks:%d@."
-        (Array.length names.consts)
-        (Array.length names.blocks); *)
-      compile_switch switch_arg sw lambda_cxt names
+    | Lswitch(switch_arg, sw) ->
+      compile_switch switch_arg sw lambda_cxt
     | Lstaticraise(i, largs) ->  
       compile_staticraise i largs lambda_cxt 
     | Lstaticcatch _  ->

jscomp/core/lam_convert.ml

@@ -96,7 +96,7 @@ let exception_id_destructed (l : Lam.t) (fv : Ident.t): bool  =
       hit fn || hit_list args
     | Lglobal_module _  (* global persistent module, play safe *)
       -> false
-    | Lswitch(arg, sw, _names) ->
+    | Lswitch(arg, sw) ->
       hit arg ||
       hit_list_snd sw.sw_consts ||
       hit_list_snd sw.sw_blocks ||
@@ -623,10 +623,10 @@ let convert (exports : Ident_set.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
 #if OCAML_VERSION =~ ">4.03.0" then
       (e,s, _loc)
 #else
-      (e,s, names) 
+      (e,s) 
 #end      
       ->
-       convert_switch e s names
+       convert_switch e s
     | Lstringswitch (e, cases, default, _ ) ->
       Lam.stringswitch 
       (convert_aux e) 
@@ -727,8 +727,7 @@ let convert (exports : Ident_set.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
                    sw_consts ;
                    sw_blocks = []; sw_numblocks = true;
                    sw_failaction = Some ifso
-                 } as px),
-                 names
+                 } as px)
                 ) 
         when Ident.same switcher3 id    &&
              not (Lam_hit.hit_variable id ifso ) && 
@@ -740,7 +739,6 @@ let convert (exports : Ident_set.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
              Ext_list.map sw_consts 
                (fun (i,act) -> i - offset, act)
           }
-          names
       | _ -> 
         Lam.let_ kind id new_e new_body
   and convert_pipe (f : Lambda.lambda) (x : Lambda.lambda) outer_loc =        
@@ -759,9 +757,9 @@ let convert (exports : Ident_set.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
         Lam.apply fn (Ext_list.append_one args x) outer_loc App_na
       | _ ->
         Lam.apply f [x] outer_loc App_na
-    and convert_switch (e : Lambda.lambda) (s : Lambda.lambda_switch) (names : Lambda.switch_names option) = 
+    and convert_switch (e : Lambda.lambda) (s : Lambda.lambda_switch) = 
         let  e = convert_aux e in
-        let names = match names with
+        let sw_names = match s.sw_names with
           | None -> None
           | Some {consts; blocks} ->
             Some {Lam.consts; blocks} in
@@ -788,18 +786,18 @@ let convert (exports : Ident_set.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
                  sw_consts =
                    Ext_list.map_snd  sw_consts convert_aux;
                  sw_numconsts = 
-                   Ext_list.length_ge sw_consts sw_numconsts
+                   Ext_list.length_ge sw_consts sw_numconsts;
+                 sw_names;
                 }
-                names
           end
         | _ -> 
           Lam.switch  e   
             { sw_numconsts =  Ext_list.length_ge s.sw_consts s.sw_numconsts ;
               sw_consts = Ext_list.map_snd  s.sw_consts convert_aux;
               sw_numblocks = Ext_list.length_ge s.sw_blocks s.sw_numblocks;
               sw_blocks = Ext_list.map_snd s.sw_blocks convert_aux;
-              sw_failaction =Ext_option.map s.sw_failaction convert_aux }
-            names in
+              sw_failaction =Ext_option.map s.sw_failaction convert_aux;
+              sw_names; } in
   convert_aux lam , may_depends
 
 

jscomp/core/lam_exit_count.ml

@@ -75,7 +75,7 @@ let count_helper  (lam : Lam.t) : collection =
       Ext_list.iter_snd bindings count;
       count body    
     | Lprim {args;  _} -> List.iter count args
-    | Lswitch(l, sw, _names) ->
+    | Lswitch(l, sw) ->
       count_default sw ;
       count l;
       Ext_list.iter_snd sw.sw_consts count;