clean up

Author: bobzhang

jscomp/.merlin

@@ -24,4 +24,4 @@ S depends
 B depends
 PKG compiler-libs.common
 B +compiler-libs
-FLG -w -40-30
+FLG -w -40-30+6

jscomp/bin/whole_compiler.ml

@@ -94498,18 +94498,18 @@ end = struct
    TODO: 
    we should have a pass called, always inlinable
    as long as its length is smaller than [exit=exit_id], for example
-   
+
    {[
-      switch(box_name)
+     switch(box_name)
        {case "":exit=178;break;
         case "b":exit=178;break;
         case "h":box_type=/* Pp_hbox */0;break;
         case "hov":box_type=/* Pp_hovbox */3;break;
         case "hv":box_type=/* Pp_hvbox */2;break;
         case "v":box_type=/* Pp_vbox */1;break;
         default:box_type=invalid_box(/* () */0);}
-      
-      switch(exit){case 178:box_type=/* Pp_box */4;break}
+
+       switch(exit){case 178:box_type=/* Pp_box */4;break}
    ]}
 *)
 
@@ -94591,14 +94591,15 @@ let count_helper  (lam : Lam.t) : int ref Int_hashtbl.t  =
       if
         nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
       then 
-        begin (* default action will occur twice in native code *)
-          count al ; count al
-          (** 
+        (*
               Reason: for pattern match, 
               we will  test whether it is 
               an integer or block, both have default cases
               predicate: [sw_numconsts] vs nconsts
           *)
+
+        begin 
+          count al ; count al
         end 
       else 
         begin (* default action will occur once *)
@@ -94632,7 +94633,7 @@ type subst_tbl = (Ident.t list * Lam.t) Int_hashtbl.t
 *)
 
 
-let subst_helper (subst : subst_tbl) query lam = 
+let subst_helper (subst : subst_tbl) (query : int -> int) lam = 
   let rec simplif (lam : Lam.t) = 
     match lam with 
     | Lstaticraise (i,[])  ->
@@ -94653,7 +94654,7 @@ let subst_helper (subst : subst_tbl) query lam =
           List.fold_right2
             (fun y l r -> Lam.let_ Alias y l r)
             ys ls 
-               (Lam_util.subst_lambda  env  handler)
+            (Lam_util.subst_lambda  env  handler)
         | None -> Lam.staticraise i ls
       end
     | Lstaticcatch (l1,(i,[]),(Lstaticraise (j,[]) as l2)) ->
@@ -94707,12 +94708,12 @@ let subst_helper (subst : subst_tbl) query lam =
           *)
           let lam_size = Lam_analysis.size l2 in
           let ok_to_inline = 
-             i >=0 && 
-             ( (j <= 2 && lam_size < Lam_analysis.exit_inline_size   )
-               || lam_size < 5)
-             (*TODO: when we do the case merging on the js side, 
-               the j is not very indicative                
-             *)             
+            i >=0 && 
+            ( (j <= 2 && lam_size < Lam_analysis.exit_inline_size   )
+              || lam_size < 5)
+            (*TODO: when we do the case merging on the js side, 
+              the j is not very indicative                
+            *)             
           in 
           if ok_to_inline (* && false *) 
           then 
@@ -94742,20 +94743,20 @@ let subst_helper (subst : subst_tbl) query lam =
       and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
       and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
       and new_fail = 
-      begin match sw.sw_failaction with 
-      | None   -> None
-      | Some x -> Some (simplif x) end in
+        begin match sw.sw_failaction with 
+          | None   -> None
+          | Some x -> Some (simplif x) end in
       Lam.switch
         new_l
-         { 
-           sw with 
-           sw_consts = new_consts ;
-           sw_blocks = new_blocks; 
-           sw_failaction = new_fail}
+        { 
+          sw with 
+          sw_consts = new_consts ;
+          sw_blocks = new_blocks; 
+          sw_failaction = new_fail}
     | Lstringswitch(l,sw,d) ->
       Lam.stringswitch
         (simplif l) (List.map (fun (s,l) -> s,simplif l) sw)
-         (begin match d with None -> None | Some d -> Some (simplif d) end)
+        (begin match d with None -> None | Some d -> Some (simplif d) end)
     | Ltrywith (l1, v, l2) -> 
       Lam.try_ (simplif l1) v (simplif l2)
     | Lifthenelse (l1, l2, l3) -> 
@@ -94772,7 +94773,7 @@ let subst_helper (subst : subst_tbl) query lam =
       Lam.ifused v (simplif l)
   in 
   simplif lam 
- 
+
 let simplify_exits (lam : Lam.t) =
   let exits = count_helper lam in
   subst_helper (Int_hashtbl.create 17 ) (count_exit exits) lam

jscomp/core/lam_pass_exits.ml

@@ -15,18 +15,18 @@
    TODO: 
    we should have a pass called, always inlinable
    as long as its length is smaller than [exit=exit_id], for example
-   
+
    {[
-      switch(box_name)
+     switch(box_name)
        {case "":exit=178;break;
         case "b":exit=178;break;
         case "h":box_type=/* Pp_hbox */0;break;
         case "hov":box_type=/* Pp_hovbox */3;break;
         case "hv":box_type=/* Pp_hvbox */2;break;
         case "v":box_type=/* Pp_vbox */1;break;
         default:box_type=invalid_box(/* () */0);}
-      
-      switch(exit){case 178:box_type=/* Pp_box */4;break}
+
+       switch(exit){case 178:box_type=/* Pp_box */4;break}
    ]}
 *)
 
@@ -108,14 +108,15 @@ let count_helper  (lam : Lam.t) : int ref Int_hashtbl.t  =
       if
         nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
       then 
-        begin (* default action will occur twice in native code *)
-          count al ; count al
-          (** 
+        (*
               Reason: for pattern match, 
               we will  test whether it is 
               an integer or block, both have default cases
               predicate: [sw_numconsts] vs nconsts
           *)
+
+        begin 
+          count al ; count al
         end 
       else 
         begin (* default action will occur once *)
@@ -149,7 +150,7 @@ type subst_tbl = (Ident.t list * Lam.t) Int_hashtbl.t
 *)
 
 
-let subst_helper (subst : subst_tbl) query lam = 
+let subst_helper (subst : subst_tbl) (query : int -> int) lam = 
   let rec simplif (lam : Lam.t) = 
     match lam with 
     | Lstaticraise (i,[])  ->
@@ -170,7 +171,7 @@ let subst_helper (subst : subst_tbl) query lam =
           List.fold_right2
             (fun y l r -> Lam.let_ Alias y l r)
             ys ls 
-               (Lam_util.subst_lambda  env  handler)
+            (Lam_util.subst_lambda  env  handler)
         | None -> Lam.staticraise i ls
       end
     | Lstaticcatch (l1,(i,[]),(Lstaticraise (j,[]) as l2)) ->
@@ -224,12 +225,12 @@ let subst_helper (subst : subst_tbl) query lam =
           *)
           let lam_size = Lam_analysis.size l2 in
           let ok_to_inline = 
-             i >=0 && 
-             ( (j <= 2 && lam_size < Lam_analysis.exit_inline_size   )
-               || lam_size < 5)
-             (*TODO: when we do the case merging on the js side, 
-               the j is not very indicative                
-             *)             
+            i >=0 && 
+            ( (j <= 2 && lam_size < Lam_analysis.exit_inline_size   )
+              || lam_size < 5)
+            (*TODO: when we do the case merging on the js side, 
+              the j is not very indicative                
+            *)             
           in 
           if ok_to_inline (* && false *) 
           then 
@@ -259,20 +260,20 @@ let subst_helper (subst : subst_tbl) query lam =
       and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
       and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
       and new_fail = 
-      begin match sw.sw_failaction with 
-      | None   -> None
-      | Some x -> Some (simplif x) end in
+        begin match sw.sw_failaction with 
+          | None   -> None
+          | Some x -> Some (simplif x) end in
       Lam.switch
         new_l
-         { 
-           sw with 
-           sw_consts = new_consts ;
-           sw_blocks = new_blocks; 
-           sw_failaction = new_fail}
+        { 
+          sw with 
+          sw_consts = new_consts ;
+          sw_blocks = new_blocks; 
+          sw_failaction = new_fail}
     | Lstringswitch(l,sw,d) ->
       Lam.stringswitch
         (simplif l) (List.map (fun (s,l) -> s,simplif l) sw)
-         (begin match d with None -> None | Some d -> Some (simplif d) end)
+        (begin match d with None -> None | Some d -> Some (simplif d) end)
     | Ltrywith (l1, v, l2) -> 
       Lam.try_ (simplif l1) v (simplif l2)
     | Lifthenelse (l1, l2, l3) -> 
@@ -289,7 +290,7 @@ let subst_helper (subst : subst_tbl) query lam =
       Lam.ifused v (simplif l)
   in 
   simplif lam 
- 
+
 let simplify_exits (lam : Lam.t) =
   let exits = count_helper lam in
   subst_helper (Int_hashtbl.create 17 ) (count_exit exits) lam

jscomp/test/.depend

@@ -152,6 +152,7 @@ ffi_js_test.cmj : ../stdlib/obj.cmj mt.cmj ../others/js_obj.cmj \
 ffi_splice_test.cmj : mt.cmj
 ffi_test.cmj : ../runtime/js.cmj
 fib.cmj :
+flattern_order_test.cmj : ../stdlib/list.cmj
 flexible_array_test.cmj : ../stdlib/format.cmj ../stdlib/array.cmj
 float_array.cmj :
 float_of_bits_test.cmj : ../stdlib/printf.cmj mt.cmj ../stdlib/list.cmj \

jscomp/test/Makefile

@@ -74,7 +74,8 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	math_test bal_set_mini gpr_974_test test_cpp\
 	global_module_alias_test class_fib_open_recursion_test\
 	topsort_test flexible_array_test\
-	gray_code_test alias_test
+	gray_code_test alias_test\
+	flattern_order_test
 
 
 

jscomp/test/flattern_order_test.js

@@ -0,0 +1,81 @@
+'use strict';
+
+var Caml_obj = require("../../lib/js/caml_obj");
+var List     = require("../../lib/js/list");
+
+function _zs() {
+  return /* tuple */[
+          List.hd(ys),
+          List.hd(xs[0])
+        ];
+}
+
+var ys = [];
+
+var xs = [];
+
+Caml_obj.caml_update_dummy(ys, /* :: */[
+      1,
+      ys
+    ]);
+
+Caml_obj.caml_update_dummy(xs, /* tuple */[
+      /* :: */[
+        2,
+        /* :: */[
+          List.hd(ys),
+          /* [] */0
+        ]
+      ],
+      _zs
+    ]);
+
+function even(_n) {
+  while(true) {
+    var n = _n;
+    if (n) {
+      _n = n - 1 | 0;
+      continue ;
+      
+    }
+    else {
+      return /* true */1;
+    }
+  };
+}
+
+function even2(n) {
+  if (n) {
+    var n$1 = n - 1 | 0;
+    if (n$1 === 1) {
+      return /* true */1;
+    }
+    else {
+      return even2(n$1 - 1 | 0);
+    }
+  }
+  else {
+    return /* true */1;
+  }
+}
+
+var v = [0];
+
+var obj = [];
+
+Caml_obj.caml_update_dummy(obj, /* record */[
+      /* get */function () {
+        return v[0];
+      },
+      /* set */function (i) {
+        v[0] = i;
+        return /* () */0;
+      }
+    ]);
+
+exports.xs    = xs;
+exports.even  = even;
+exports.even2 = even2;
+exports.v     = v;
+exports.obj   = obj;
+/* xs Not a pure module */

jscomp/test/flattern_order_test.ml

@@ -0,0 +1,43 @@
+
+
+let rec xs = 
+  let rec ys = 1 :: ys 
+  and _zs () = (List.hd ys, List.hd (fst xs))  in
+  (* and us = 3 in  *)
+  (* Js.log us; *)
+  (2 :: List.hd ys :: [], _zs)
+
+(*
+let second xs =
+    let rec ys = 1 :: ys 
+    and _zs () = List.hd xs 
+    (* and us = 3 in  *) in
+
+    xs 
+
+let f x = 
+    let f0 a = a+1 in 
+    let f1 a  = f0 a + 1  in 
+    let f2 a = f1 a + 1 in 
+    f2 x    
+*)    
+
+let rec even = 
+    let odd = even in 
+    fun n -> if n == 0 then true else odd (n - 1)
+
+
+let rec even2 =
+    let odd n = if n == 1 then true else even2 (n - 1) in 
+    fun n -> if n == 0 then true else odd (n - 1)
+
+type t =
+    { get : unit -> int ;
+      set : int -> unit ; 
+    } 
+
+let v = ref 0 
+let rec obj = 
+    { get = (fun _ -> !v);
+      set = (fun i -> v := i )
+    }