Compiler: exit loop early (experiment)

Author: hhugo

compiler/lib/structure.ml

@@ -174,15 +174,24 @@ let build_graph blocks pc =
     (* Create an artificial frontier when for-loops are not longer necessary *)
     List.iter !loops ~f:(fun pc ->
         let pc_loop = pc in
-        let set = compute_exit_loop pc_loop in
-        let preds =
-          Hashtbl.find preds pc_loop
-          |> Addr.Set.filter (fun pred -> is_forward' block_order pred pc_loop)
+        let l =
+          compute_exit_loop pc_loop
+          |> Addr.Set.elements
+          |> List.sort ~cmp:(fun a b ->
+                 compare (Hashtbl.find block_order b) (Hashtbl.find block_order a))
         in
-        Addr.Set.iter
-          (fun pc_loop_anc ->
-            Addr.Set.iter (fun exit_pc -> add_edge pc_loop_anc exit_pc) set)
-          preds)
+        match l with
+        | [] -> ()
+        | pc :: _ ->
+            let set = Addr.Set.singleton pc in
+            let preds =
+              Hashtbl.find preds pc_loop
+              |> Addr.Set.filter (fun pred -> is_forward' block_order pred pc_loop)
+            in
+            Addr.Set.iter
+              (fun pc_loop_anc ->
+                Addr.Set.iter (fun exit_pc -> add_edge pc_loop_anc exit_pc) set)
+              preds)
   in
   { succs; preds; reverse_post_order = !l; block_order }
 

compiler/tests-compiler/gh1007.ml

@@ -219,20 +219,15 @@ let ()  = M.myfun M.x
            s2 = match$1[1];
           a:
           {
-           b:
-           {
-            var l1 = s1, l2 = s2, accu = 0;
-            for(;;){
-             if(! l1) break;
-             if(! l2) break b;
-             var t2 = l2[2], h2 = l2[1], t1 = l1[2], h1 = l1[1];
-             if(0 < caml_int_compare(h1, h2))
-              var accu$0 = [0, h2, accu], l2 = t2, accu = accu$0;
-             else
-              var accu$1 = [0, h1, accu], l1 = t1, accu = accu$1;
-            }
-            var _c_ = rev_append(l2, accu);
-            break a;
+           var l1 = s1, l2 = s2, accu = 0;
+           for(;;){
+            if(! l1){var _c_ = rev_append(l2, accu); break a;}
+            if(! l2) break;
+            var t2 = l2[2], h2 = l2[1], t1 = l1[2], h1 = l1[1];
+            if(0 < caml_int_compare(h1, h2))
+             var accu$0 = [0, h2, accu], l2 = t2, accu = accu$0;
+            else
+             var accu$1 = [0, h1, accu], l1 = t1, accu = accu$1;
            }
            var _c_ = rev_append(l1, accu);
           }
@@ -297,20 +292,15 @@ let ()  = M.myfun M.x
            s2 = match$1[1];
           a:
           {
-           b:
-           {
-            var l1 = s1, l2 = s2, accu = 0;
-            for(;;){
-             if(! l1) break;
-             if(! l2) break b;
-             var t2 = l2[2], h2 = l2[1], t1 = l1[2], h1 = l1[1];
-             if(0 < caml_int_compare(h1, h2))
-              var accu$0 = [0, h1, accu], l1 = t1, accu = accu$0;
-             else
-              var accu$1 = [0, h2, accu], l2 = t2, accu = accu$1;
-            }
-            var _a_ = rev_append(l2, accu);
-            break a;
+           var l1 = s1, l2 = s2, accu = 0;
+           for(;;){
+            if(! l1){var _a_ = rev_append(l2, accu); break a;}
+            if(! l2) break;
+            var t2 = l2[2], h2 = l2[1], t1 = l1[2], h1 = l1[1];
+            if(0 < caml_int_compare(h1, h2))
+             var accu$0 = [0, h1, accu], l1 = t1, accu = accu$0;
+            else
+             var accu$1 = [0, h2, accu], l2 = t2, accu = accu$1;
            }
            var _a_ = rev_append(l1, accu);
           }

compiler/tests-compiler/inlining.ml

@@ -26,8 +26,7 @@ let%expect_test "inline recursive function" =
   |} in
   print_fun_decl program (Some "f");
   print_fun_decl program (Some "g");
-  [%expect
-    {|
+  [%expect{|
     function f(param){for(;;) ;}
     //end
     function g(param){return f(0);}