remove certainity which is useless

bobzhang · bobzhang · commit 28bd7e906b48 · 2018-04-13T11:02:33.000+08:00
diff --git a/jscomp/core/lam_arity.ml b/jscomp/core/lam_arity.ml
@@ -24,9 +24,8 @@
 
 
 type t = 
-  | Arity_info of bool * int  list  * bool
+  | Arity_info of  int  list  * bool
   (**
-     when the first argument is true, it is for sure 
      the last one means it can take any params later, 
      for an exception: it is (Determin (true,[], true))
      1. approximation sound but not complete 
@@ -39,12 +38,9 @@ let pp = Format.fprintf
 let print (fmt : Format.formatter) (x : t) = 
   match x with 
   | Arity_na -> pp fmt "?"
-  | Arity_info (b,ls,tail) -> 
+  | Arity_info (ls,tail) -> 
     begin 
       pp fmt "@[";
-      (if not b 
-       then 
-         pp fmt "~");
       pp fmt "[";
       Format.pp_print_list ~pp_sep:(fun fmt () -> pp fmt ",")
         (fun fmt  x -> Format.pp_print_int fmt x)
@@ -68,58 +64,56 @@ let merge
     (n : int )
     (x : t) : t = 
   match x with 
-  | Arity_na -> Arity_info (false, [n], false)
-  | Arity_info (b,xs,tail) -> Arity_info (b, n :: xs, tail)
+  | Arity_na -> Arity_info ( [n], false)
+  | Arity_info (xs,tail) -> Arity_info ( n :: xs, tail)
 
 
 let non_function_arity_info =   
-  Arity_info (true, [], false)
+  Arity_info ([], false)
 
 let raise_arity_info =   
-  Arity_info (true,[],true)
+  Arity_info ([],true)
 
 let na = Arity_na
 
-let info b0 args b1 = 
-  Arity_info (b0, args, b1)
+let info args b1 = 
+  Arity_info ( args, b1)
 
 
 let first_arity_na ( x : t ) =   
   match x with 
   | Arity_na 
-  | Arity_info (_, [], _) -> true
+  | Arity_info ( [], _) -> true
   | _ -> false
 
 let get_first_arity (x : t) =   
   match x with 
   | Arity_na 
-  | Arity_info (_, [], _) -> None
-  | Arity_info (_, x::_, _) ->  Some x
+  | Arity_info ( [], _) -> None
+  | Arity_info ( x::_, _) ->  Some x
 
 let extract_arity ( x : t) =   
   match x with 
   | Arity_na  -> []
-  | Arity_info(_,xs,_) ->  xs 
+  | Arity_info(xs,_) ->  xs 
 
 (* let update_arity (x : t) xs =    *)
 
 let rec
   merge_arities_aux 
     (acc : int list) 
-    (unused_b : bool) 
     (xs : int list) (ys : int list) (tail : bool) (tail2 : bool) = 
   match xs,ys with
   | [], [] -> 
-    info unused_b (List.rev acc) (tail && tail2) 
-  (* tail && tail2 *)
+    info (List.rev acc) (tail && tail2) 
   | [], y::ys when tail  -> 
-    merge_arities_aux (y::acc) unused_b  [] ys tail tail2
+    merge_arities_aux (y::acc)   [] ys tail tail2
   | x::xs, [] when tail2 -> 
-    merge_arities_aux (x::acc) unused_b  [] xs tail tail2
+    merge_arities_aux (x::acc)   [] xs tail tail2
   | x::xs, y::ys when x = y ->
-    merge_arities_aux (y :: acc) unused_b  xs ys tail tail2
+    merge_arities_aux (y :: acc)   xs ys tail tail2
   | _, _  -> 
-  info false (List.rev acc) false
+  info (List.rev acc) false
 
-let merge_arities b xs ys t t2 = 
-  merge_arities_aux [] b xs ys t t2
+let merge_arities  xs ys t t2 = 
+  merge_arities_aux []  xs ys t t2
diff --git a/jscomp/core/lam_arity.mli b/jscomp/core/lam_arity.mli
@@ -24,13 +24,12 @@
 
 
 type t = private
-  | Arity_info of bool * int list  * bool
+  | Arity_info of int list  * bool
     (**
       when the first argument is true, it is for sure 
       the last one means it can take any params later, 
-      for an exception: it is (Determin (true,[], true))
-      1. approximation sound but not complete 
-      
+      for an exception: it is (Arity_info([], true))
+       approximation sound but not complete       
    *)
   | Arity_na 
 
@@ -48,7 +47,7 @@ val non_function_arity_info : t
 val raise_arity_info : t 
 
 val na : t
-val info : bool -> int list -> bool -> t 
+val info : int list -> bool -> t 
 
 val first_arity_na :  t -> bool
 val get_first_arity : t -> int option 
@@ -57,7 +56,6 @@ val get_first_arity : t -> int option
 val extract_arity : t -> int list 
 
 val merge_arities : 
-  bool -> 
   int list -> 
   int list -> 
   bool -> 
diff --git a/jscomp/core/lam_arity_analysis.ml b/jscomp/core/lam_arity_analysis.ml
@@ -82,18 +82,18 @@ let rec get_arity (meta : Lam_stats.t) (lam : Lam.t) :  Lam_arity.t =
     let fn = get_arity meta app in 
     begin match fn with 
       | Arity_na -> Lam_arity.na
-      | Arity_info (b, xs, tail ) -> 
+      | Arity_info ( xs, tail ) -> 
         let rec take (arities : _ list) arg_length = 
           match arities with 
           | x :: yys ->
-            if arg_length = x then Lam_arity.info b yys tail
+            if arg_length = x then Lam_arity.info  yys tail
             else if arg_length > x then
               take yys (arg_length - x)
-            else Lam_arity.info b 
+            else Lam_arity.info 
                 ((x -  arg_length ) :: yys)
                 tail
           | [] -> 
-            if tail then Lam_arity.info b [] tail            
+            if tail then Lam_arity.raise_arity_info
             else Lam_arity.na
             (* Actually, you can not have truly deministic arities
                for example [fun x -> x ]
@@ -140,12 +140,12 @@ and all_lambdas meta (xs : Lam.t list) =
       match acc, xs  with 
       | Arity_na, _ -> acc 
       | _, [] -> acc 
-      | Arity_info(bbb, xxxs, tail), y::ys ->
+      | Arity_info(xxxs, tail), y::ys ->
         match get_arity meta y with 
         | Arity_na -> Lam_arity.na
-        | Arity_info (u,yyys,tail2) -> 
+        | Arity_info (yyys,tail2) -> 
           aux 
-            (Lam_arity.merge_arities ( u && bbb )  xxxs yyys tail tail2)
+            (Lam_arity.merge_arities xxxs yyys tail tail2)
             ys
     in  aux arity ys     
 
diff --git a/jscomp/core/lam_pass_collect.ml b/jscomp/core/lam_pass_collect.ml
@@ -29,36 +29,30 @@
 
 
 
-
-let annotate (meta : Lam_stats.t)
-    rec_flag    
-    (k:Ident.t) (v : Lam_arity.t) lambda = 
-  (* Ext_log.dwarn  __LOC__ "%s/%d" k.name k.stamp;     *)
+(** Check, it is shared across ident_tbl, 
+    Only [Lassign] will break such invariant,
+    how about guarantee that [Lassign] only check the local ref 
+    and we track which ids are [Lassign]ed
+*)
+(**
+   might not be the same due to refinement
+   assert (old.arity = v) 
+*)
+let annotate (meta : Lam_stats.t)  rec_flag  (k:Ident.t) (arity : Lam_arity.t) lambda = 
   match Ident_hashtbl.find_opt  meta.ident_tbl k  with 
   | None -> (** FIXME: need do a sanity check of arity is NA or Determin(_,[],_) *)
-      Ident_hashtbl.add meta.ident_tbl k 
-        (FunctionId {
-            arity = v; lambda; rec_flag})
+    Ident_hashtbl.add meta.ident_tbl k 
+      (FunctionId {arity; lambda; rec_flag})
   |  Some (FunctionId old)  ->  
-      (** Check, it is shared across ident_tbl, 
-          Only [Lassign] will break such invariant,
-          how about guarantee that [Lassign] only check the local ref 
-          and we track which ids are [Lassign]ed
-       *)
-      (**
-         might not be the same due to refinement
-         assert (old.arity = v) 
-       *)
-        old.arity <- v  (* due to we keep refining arity analysis after each round*)
-      
 
+    old.arity <- arity  (* due to we keep refining arity analysis after each round*)      
   | _ -> assert false (* TODO -- avoid exception *)
 
 
 (** it only make senses recording arities for 
     function definition,
     alias propgation - and toplevel identifiers, this needs to be exported
- *)
+*)
 let collect_helper  (meta : Lam_stats.t) (lam : Lam.t)  = 
   let rec collect_bind rec_flag
       (kind : Lam.let_kind) 
@@ -90,83 +84,83 @@ let collect_helper  (meta : Lam_stats.t) (lam : Lam.t)  =
         (Lam_util.kind_of_lambda_block Null_undefined ls )
     | Lglobal_module v  
       -> 
-        Lam_util.alias_ident_or_global meta  ident v (Module  v) kind; 
+      Lam_util.alias_ident_or_global meta  ident v (Module  v) kind; 
     | Lvar v 
       -> 
-        (
-         (* if Ident.global v then  *)
-         Lam_util.alias_ident_or_global meta  ident v NA kind
-           (* enven for not subsitution, it still propogate some properties *)
-           (* else () *)
-        )
-    | Lfunction{ params; body = l}
-        (** TODO record parameters ident ?, but it will be broken after inlining *)  
+      (
+        (* if Ident.global v then  *)
+        Lam_util.alias_ident_or_global meta  ident v NA kind
+        (* enven for not subsitution, it still propogate some properties *)
+        (* else () *)
+      )
+    | Lfunction{ params; body}
+      (** TODO record parameters ident ?, but it will be broken after inlining *)  
       -> 
-        (** TODO could be optimized in one pass? 
-            -- since collect would iter everywhere,
-            so -- it would still iterate internally
-         *)
+      (** TODO could be optimized in one pass? 
+          -- since collect would iter everywhere,
+          so -- it would still iterate internally
+      *)
 
       List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
       let arity = Lam_arity_analysis.get_arity meta lam in       
       annotate meta rec_flag ident  arity lam; 
-      collect l
+      collect body
     | x -> 
-        collect x ;
-        if Ident_set.mem ident meta.export_idents then 
-          annotate meta rec_flag ident (Lam_arity_analysis.get_arity meta x ) lam
+      collect x ;
+      if Ident_set.mem ident meta.export_idents then 
+        annotate meta rec_flag ident (Lam_arity_analysis.get_arity meta x ) lam
 
 
   and collect  (lam : Lam.t)  =
     match lam with 
 
-        (** TODO: 
-            how about module aliases..
-            record dependency
-            --- tricky -- if we inlining, 
-            is it safe to remove it? probably not...
-         *)
+    (** TODO: 
+        how about module aliases..
+        record dependency
+        --- tricky -- if we inlining, 
+        is it safe to remove it? probably not...
+    *)
     | Lconst _ -> ()
     | Lvar _ -> ()
     | Lapply{fn = l1; args =  ll; _} ->
-        collect  l1; List.iter collect  ll
+      collect  l1; List.iter collect  ll
     | Lfunction { params; body =  l} -> (* functor ? *)
-        List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
-        collect  l
+      List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
+      collect  l
     | Llet (kind,ident,arg,body) -> 
-        collect_bind Non_rec kind ident arg ; collect body
+      collect_bind Non_rec kind ident arg ; collect body
     | Lletrec (bindings, body) -> 
-        List.iter (fun (ident,arg) -> collect_bind Rec  Strict ident arg ) bindings;
-        collect body
+      List.iter (fun (ident,arg) -> collect_bind Rec  Strict ident arg ) bindings;
+      collect body
     | Lglobal_module _ -> ()
     | Lprim {args; _} -> List.iter collect  args
     | Lswitch(l, {sw_failaction; sw_consts; sw_blocks}) ->
-        collect  l;
-        List.iter (fun (_, l) -> collect  l) sw_consts;
-        List.iter (fun (_, l) -> collect  l) sw_blocks;
-        begin match sw_failaction with 
+      collect  l;
+      List.iter (fun (_, l) -> collect  l) sw_consts;
+      List.iter (fun (_, l) -> collect  l) sw_blocks;
+      begin match sw_failaction with 
         | None -> ()
         | Some x -> collect x
-        end
+      end
     | Lstringswitch(l, sw, d) ->
-        collect  l ;
-        List.iter (fun (_, l) -> collect  l) sw ;
-        begin match d with
+      collect  l ;
+      List.iter (fun (_, l) -> collect  l) sw ;
+      begin match d with
         | Some d -> collect d 
         | None -> ()
-        end
+      end
     | Lstaticraise (code,ls) -> 
-          List.iter collect  ls
+      List.iter collect  ls
     | Lstaticcatch(l1, (_,_), l2) -> collect  l1; collect  l2
     | Ltrywith(l1, _, l2) -> collect  l1; collect  l2
     | Lifthenelse(l1, l2, l3) -> collect  l1; collect  l2; collect  l3
     | Lsequence(l1, l2) -> collect  l1; collect  l2
     | Lwhile(l1, l2) -> collect  l1; collect l2
     | Lfor(_, l1, l2, dir, l3) -> collect  l1; collect  l2; collect  l3
     | Lassign(v, l) ->
-        (* Lalias-bound variables are never assigned, so don't increase
-           v's refcollect *)
-        collect  l
+      (* Lalias-bound variables are never assigned, so don't increase
+         v's refcollect *)
+      collect  l
     | Lsend(_, m, o, ll, _) -> List.iter collect  (m::o::ll)
     | Lifused(_, l) -> collect  l in collect lam 
 
@@ -181,11 +175,11 @@ let count_alias_globals
   let meta : Lam_stats.t = 
     {alias_tbl = Ident_hashtbl.create 31 ; 
      ident_tbl = Ident_hashtbl.create 31;
-     
+
      exports =  export_idents;
      filename;
      env;
      export_idents = export_sets;
-   } in 
+    } in 
   collect_helper  meta lam ; 
   meta
diff --git a/lib/whole_compiler.ml b/lib/whole_compiler.ml
