Compiler: avoid nesting loops if unnecessary

Author: hhugo

compiler/lib/structure.ml

@@ -189,15 +189,18 @@ let mark_loops g =
   in_loop
 
 let rec measure blocks g pc limit =
-  let b = Addr.Map.find pc blocks in
-  let limit = limit - List.length b.body in
-  if limit < 0
-  then limit
+  if is_loop_header g pc
+  then -1
   else
-    Addr.Set.fold
-      (fun pc limit -> if limit < 0 then limit else measure blocks g pc limit)
-      (get_edges g.succs pc)
-      limit
+    let b = Addr.Map.find pc blocks in
+    let limit = limit - List.length b.body in
+    if limit < 0
+    then limit
+    else
+      Addr.Set.fold
+        (fun pc limit -> if limit < 0 then limit else measure blocks g pc limit)
+        (get_edges g.succs pc)
+        limit
 
 let is_small blocks g pc = measure blocks g pc 20 >= 0
 
@@ -225,20 +228,16 @@ let shrink_loops blocks ({ succs; preds; reverse_post_order; _ } as g) =
         in
         let loops' = get_edges in_loop pc' in
         let left_loops = Addr.Set.diff (Addr.Set.diff loops loops') ignored in
-        (* If we leave a loop, we add an edge from a predecessor of
+        (* If we leave a loop, we add an edge from predecessors of
            the loop header to the current block, so that it is
            considered outside of the loop. *)
         if not (Addr.Set.is_empty left_loops || is_small blocks g pc')
         then
           Addr.Set.iter
             (fun pc0 ->
-              match
-                Addr.Set.find_first
-                  (fun pc -> is_forward g pc pc0)
-                  (get_edges g.preds pc0)
-              with
-              | pc -> add_edge pc pc'
-              | exception Not_found -> ())
+              Addr.Set.iter
+                (fun pc -> if is_forward g pc pc0 then add_edge pc pc')
+                (get_edges g.preds pc0))
             left_loops;
         traverse ignored pc')
       succs

compiler/tests-compiler/loops.ml

@@ -167,21 +167,20 @@ let for_for_while () =
      var k = 1;
      for(;;){
       var j = 1;
-      a:
-      for(;;)
+      for(;;){
        for(;;){
-        if(10 <= caml_div(k, j)){
-         var _b_ = j + 1 | 0;
-         if(10 !== j){var j = _b_; break;}
-         var _a_ = k + 1 | 0;
-         if(10 === k) return 0;
-         var k = _a_;
-         break a;
-        }
+        if(10 <= caml_div(k, j)) break;
         try{caml_div(k, j);}
         catch(_c_){throw caml_maybe_attach_backtrace(Stdlib[8], 1);}
         id[1]++;
        }
+       var _b_ = j + 1 | 0;
+       if(10 === j) break;
+       var j = _b_;
+      }
+      var _a_ = k + 1 | 0;
+      if(10 === k) return 0;
+      var k = _a_;
      }
     }
     //end |}]
@@ -569,29 +568,31 @@ let () = print_endline (trim " ")
       len = caml_ml_bytes_length(s$0),
       i = [0, 0];
      for(;;){
-      if(i[1] < len && is_space(caml_bytes_unsafe_get(s$0, i[1]))){i[1]++; continue;}
-      var j = [0, len - 1 | 0];
-      for(;;){
-       if(i[1] > j[1]) break;
-       if(! is_space(caml_bytes_unsafe_get(s$0, j[1]))) break;
-       j[1] += - 1;
-      }
-      a:
-      {
-       if(i[1] <= j[1]){
-        var len$0 = (j[1] - i[1] | 0) + 1 | 0, ofs = i[1];
-        if
-         (0 <= ofs && 0 <= len$0 && (caml_ml_bytes_length(s$0) - len$0 | 0) >= ofs){
-         var r = caml_create_bytes(len$0);
-         caml_blit_bytes(s$0, ofs, r, 0, len$0);
-         var b = r;
-         break a;
-        }
-        throw caml_maybe_attach_backtrace([0, Invalid_argument, s], 1);
+      if(i[1] >= len) break;
+      if(! is_space(caml_bytes_unsafe_get(s$0, i[1]))) break;
+      i[1]++;
+     }
+     var j = [0, len - 1 | 0];
+     for(;;){
+      if(i[1] > j[1]) break;
+      if(! is_space(caml_bytes_unsafe_get(s$0, j[1]))) break;
+      j[1] += - 1;
+     }
+     a:
+     {
+      if(i[1] <= j[1]){
+       var len$0 = (j[1] - i[1] | 0) + 1 | 0, ofs = i[1];
+       if
+        (0 <= ofs && 0 <= len$0 && (caml_ml_bytes_length(s$0) - len$0 | 0) >= ofs){
+        var r = caml_create_bytes(len$0);
+        caml_blit_bytes(s$0, ofs, r, 0, len$0);
+        var b = r;
+        break a;
        }
-       var b = empty;
+       throw caml_maybe_attach_backtrace([0, Invalid_argument, s], 1);
       }
-      return caml_string_of_bytes(copy(b));
+      var b = empty;
      }
+     return caml_string_of_bytes(copy(b));
     }
     //end |}]

compiler/tests-full/stdlib.cma.expected.js

@@ -5239,15 +5239,17 @@
      len = caml_ml_bytes_length(s),
       /*<<bytes.ml:157:10>>*/ i = [0, 0];
     for(;;){
-      /*<<bytes.ml:158:20>>*/ if
-      (i[1] < len && is_space(caml_bytes_unsafe_get(s, i[1]))){i[1]++; continue;}
-      /*<<bytes.ml:161:10>>*/  /*<<bytes.ml:161:10>>*/ var
-      j = [0, len - 1 | 0];
-     for(;;){
-       /*<<bytes.ml:162:20>>*/ if
-       (i[1] <= j[1] && is_space(caml_bytes_unsafe_get(s, j[1]))){j[1] += -1; continue;}
-      return i[1] <= j[1] ? sub(s, i[1], (j[1] - i[1] | 0) + 1 | 0) : empty;
-     }
+     if(i[1] >= len) break;
+      /*<<bytes.ml:158:20>>*/ if(! is_space(caml_bytes_unsafe_get(s, i[1])))
+      break;
+     i[1]++;
+    }
+     /*<<bytes.ml:161:10>>*/  /*<<bytes.ml:161:10>>*/ var
+     j = [0, len - 1 | 0];
+    for(;;){
+      /*<<bytes.ml:162:20>>*/ if
+      (i[1] <= j[1] && is_space(caml_bytes_unsafe_get(s, j[1]))){j[1] += -1; continue;}
+     return i[1] <= j[1] ? sub(s, i[1], (j[1] - i[1] | 0) + 1 | 0) : empty;
     }
     /*<<bytes.ml:168:9>>*/ }
    function unsafe_escape(s){
@@ -31156,9 +31158,10 @@
             /*<<camlinternalMod.ml:75:7>>*/ cl[1 + j] = n$0[1 + j];
             /*<<camlinternalMod.ml:75:7>>*/  /*<<camlinternalMod.ml:75:7>>*/ var
             _c_ = j + 1 | 0;
-           if(3 === j) break a;
+           if(3 === j) break;
            var j = _c_;
           }
+          break a;
          }
           /*<<camlinternalMod.ml:72:5>>*/ throw  /*<<camlinternalMod.ml:72:5>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _a_], 1);