From 9c48bee7f77a2a7ddf136700c392aa64eab8b66c Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 30 Apr 2020 18:07:37 +0200
Subject: [PATCH 1/6] Tests: add regression tests for #1007

---
 compiler/tests-jsoo/gh1007.ml  | 107 +++++++++++++++++++++++++++++++++
 compiler/tests-jsoo/gh1007.mli |   1 +
 2 files changed, 108 insertions(+)
 create mode 100644 compiler/tests-jsoo/gh1007.ml
 create mode 100644 compiler/tests-jsoo/gh1007.mli

diff --git a/compiler/tests-jsoo/gh1007.ml b/compiler/tests-jsoo/gh1007.ml
new file mode 100644
index 0000000000..ea15f21d42
--- /dev/null
+++ b/compiler/tests-jsoo/gh1007.ml
@@ -0,0 +1,107 @@
+module MyList : sig
+  val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+end = struct
+  let rec length_aux len = function
+    | [] -> len
+    | _ :: l -> length_aux (len + 1) l
+
+  let length l = length_aux 0 l
+
+  let rec rev_append l1 l2 =
+    match l1 with
+    | [] -> l2
+    | a :: l -> rev_append l (a :: l2)
+
+  let stable_sort cmp l =
+    let rec rev_merge l1 l2 accu =
+      match l1, l2 with
+      | [], l2 -> rev_append l2 accu
+      | l1, [] -> rev_append l1 accu
+      | h1 :: t1, h2 :: t2 ->
+          if cmp h1 h2 <= 0
+          then rev_merge t1 l2 (h1 :: accu)
+          else rev_merge l1 t2 (h2 :: accu)
+    in
+    let rec rev_merge_rev l1 l2 accu =
+      match l1, l2 with
+      | [], l2 -> rev_append l2 accu
+      | l1, [] -> rev_append l1 accu
+      | h1 :: t1, h2 :: t2 ->
+          if cmp h1 h2 > 0
+          then rev_merge_rev t1 l2 (h1 :: accu)
+          else rev_merge_rev l1 t2 (h2 :: accu)
+    in
+    let rec sort n l =
+      match n, l with
+      | 2, x1 :: x2 :: tl ->
+          let s = if cmp x1 x2 <= 0 then [ x1; x2 ] else [ x2; x1 ] in
+          s, tl
+      | 3, x1 :: x2 :: x3 :: tl ->
+          let s =
+            if cmp x1 x2 <= 0
+            then
+              if cmp x2 x3 <= 0
+              then [ x1; x2; x3 ]
+              else if cmp x1 x3 <= 0
+              then [ x1; x3; x2 ]
+              else [ x3; x1; x2 ]
+            else if cmp x1 x3 <= 0
+            then [ x2; x1; x3 ]
+            else if cmp x2 x3 <= 0
+            then [ x2; x3; x1 ]
+            else [ x3; x2; x1 ]
+          in
+          s, tl
+      | n, l ->
+          let n1 = n asr 1 in
+          let n2 = n - n1 in
+          let s1, l2 = rev_sort n1 l in
+          let s2, tl = rev_sort n2 l2 in
+          rev_merge_rev s1 s2 [], tl
+    and rev_sort n l =
+      match n, l with
+      | 2, x1 :: x2 :: tl ->
+          let s = if cmp x1 x2 > 0 then [ x1; x2 ] else [ x2; x1 ] in
+          s, tl
+      | 3, x1 :: x2 :: x3 :: tl ->
+          let s =
+            if cmp x1 x2 > 0
+            then
+              if cmp x2 x3 > 0
+              then [ x1; x2; x3 ]
+              else if cmp x1 x3 > 0
+              then [ x1; x3; x2 ]
+              else [ x3; x1; x2 ]
+            else if cmp x1 x3 > 0
+            then [ x2; x1; x3 ]
+            else if cmp x2 x3 > 0
+            then [ x2; x3; x1 ]
+            else [ x3; x2; x1 ]
+          in
+          s, tl
+      | n, l ->
+          let n1 = n asr 1 in
+          let n2 = n - n1 in
+          let s1, l2 = sort n1 l in
+          let s2, tl = sort n2 l2 in
+          rev_merge s1 s2 [], tl
+    in
+    let len = length l in
+    if len < 2 then l else fst (sort len l)
+end
+
+type t =
+  | Empty
+  | Node of t
+
+let rec f x =
+  match x with
+  | Empty -> ()
+  | Node next ->
+      let _ = MyList.stable_sort compare [ 1; 2; 3; 4 ] in
+      f next
+
+let%expect_test _ =
+  f (Node Empty);
+  [%expect.unreachable]
+[@@expect.uncaught_exn {| (Failure "TypeError: rev_sort is not a function") |}]
diff --git a/compiler/tests-jsoo/gh1007.mli b/compiler/tests-jsoo/gh1007.mli
new file mode 100644
index 0000000000..6837f68b31
--- /dev/null
+++ b/compiler/tests-jsoo/gh1007.mli
@@ -0,0 +1 @@
+(* Empty *)

From 918e8488f844e6b82fa4010de5e9b751b82ee85c Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 30 Apr 2020 15:40:14 +0200
Subject: [PATCH 2/6] Compiler: fix generate_closure (#1007)

---
 compiler/lib/generate_closure.ml | 84 ++++++++++++++++++++++++--------
 compiler/tests-jsoo/gh1007.ml    |  3 +-
 2 files changed, 64 insertions(+), 23 deletions(-)

diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml
index edb0837fd2..06727fdba0 100644
--- a/compiler/lib/generate_closure.ml
+++ b/compiler/lib/generate_closure.ml
@@ -27,6 +27,7 @@ type closure_info =
   ; args : Code.Var.t list
   ; cont : Code.cont
   ; tc : Code.Addr.Set.t Code.Var.Map.t
+  ; ntc : Code.Addr.Set.t Code.Var.Map.t
   }
 
 type 'a int_ext =
@@ -40,9 +41,9 @@ let add_multi k v map =
   let set = try Var.Map.find k map with Not_found -> Addr.Set.empty in
   Var.Map.add k (Addr.Set.add v set) map
 
-let rec tailcall pc blocks visited tc =
+let rec collect_apply pc blocks visited tc ntc =
   if Addr.Set.mem pc visited
-  then visited, tc
+  then visited, tc, ntc
   else
     let visited = Addr.Set.add pc visited in
     let block = Addr.Map.find pc blocks in
@@ -56,39 +57,53 @@ let rec tailcall pc blocks visited tc =
           | Some _ -> None)
       | _ -> None
     in
+    let ntc =
+      List.fold_left block.body ~init:ntc ~f:(fun acc x ->
+          match x with
+          | Let (_, Apply (z, _, _)) -> add_multi z pc acc
+          | _ -> acc)
+    in
     match tc_opt with
-    | Some tc -> visited, tc
+    | Some tc -> visited, tc, ntc
     | None ->
         Code.fold_children
           blocks
           pc
-          (fun pc (visited, tc) -> tailcall pc blocks visited tc)
-          (visited, tc)
+          (fun pc (visited, tc, ntc) -> collect_apply pc blocks visited tc ntc)
+          (visited, tc, ntc)
 
 let rec collect_closures blocks l =
   match l with
   | Let (f_name, Closure (args, ((pc, _) as cont))) :: rem ->
-      let tc = snd (tailcall pc blocks Addr.Set.empty Var.Map.empty) in
+      let _, tc, ntc =
+        collect_apply pc blocks Addr.Set.empty Var.Map.empty Var.Map.empty
+      in
       let l, rem = collect_closures blocks rem in
-      { f_name; args; cont; tc } :: l, rem
+      { f_name; args; cont; tc; ntc } :: l, rem
   | rem -> [], rem
 
-let group_closures closures =
+let group_closures ~tc_only closures_map =
   let names =
-    List.fold_left closures ~init:Var.Set.empty ~f:(fun names x ->
-        Var.Set.add x.f_name names)
-  in
-  let closures_map =
-    List.fold_left closures ~init:Var.Map.empty ~f:(fun closures_map x ->
-        Var.Map.add x.f_name x closures_map)
+    Var.Map.fold (fun _ x names -> Var.Set.add x.f_name names) closures_map Var.Set.empty
   in
   let graph =
-    List.fold_left closures ~init:Var.Map.empty ~f:(fun graph x ->
-        let tc = Var.Map.fold (fun x _ tc -> Var.Set.add x tc) x.tc Var.Set.empty in
-        let tc = Var.Set.inter names tc in
-        Var.Map.add x.f_name tc graph)
+    Var.Map.fold
+      (fun _ x graph ->
+        let calls = Var.Map.fold (fun x _ tc -> Var.Set.add x tc) x.tc Var.Set.empty in
+        let calls =
+          if tc_only
+          then calls
+          else
+            Var.Set.union
+              calls
+              (Var.Map.fold (fun x _ ntc -> Var.Set.add x ntc) x.ntc Var.Set.empty)
+        in
+        Var.Map.add x.f_name (Var.Set.inter names calls) graph)
+      closures_map
+      Var.Map.empty
   in
-  closures_map, SCC.connected_components_sorted_from_roots_to_leaf graph
+
+  SCC.connected_components_sorted_from_roots_to_leaf graph
 
 module Trampoline = struct
   let direct_call_block block ~counter ~x ~f ~args =
@@ -360,14 +375,41 @@ let rec rewrite_closures mutated_vars rewrite_list free_pc blocks body : int * _
   match body with
   | Let (_, Closure _) :: _ ->
       let closures, rem = collect_closures blocks body in
-      let closures_map, components = group_closures closures in
+      let closures_map =
+        List.fold_left closures ~init:Var.Map.empty ~f:(fun closures_map x ->
+            Var.Map.add x.f_name x closures_map)
+      in
+      let components = group_closures ~tc_only:false closures_map in
       let free_pc, blocks, closures =
         List.fold_left
           (Array.to_list components)
           ~init:(free_pc, blocks, [])
           ~f:(fun (free_pc, blocks, acc) component ->
             let free_pc, blocks, closures =
-              rewrite_tc free_pc blocks closures_map component
+              let components =
+                match component with
+                | SCC.No_loop _ as one -> [ one ]
+                | SCC.Has_loop all ->
+                    group_closures
+                      ~tc_only:true
+                      (Var.Map.filter
+                         (fun v _ -> List.exists all ~f:(Var.equal v))
+                         closures_map)
+                    |> Array.to_list
+              in
+              List.fold_left
+                ~init:(free_pc, blocks, { int = []; ext = [] })
+                components
+                ~f:(fun (free_pc, blocks, acc) component ->
+                  let free_pc, blocks, ie =
+                    rewrite_tc free_pc blocks closures_map component
+                  in
+                  free_pc, blocks, { int = ie.int :: acc.int; ext = ie.ext :: acc.ext })
+            in
+            let closures =
+              { int = List.concat (List.rev closures.int)
+              ; ext = List.concat (List.rev closures.ext)
+              }
             in
             let free_pc, blocks, intrs =
               rewrite_mutable free_pc blocks mutated_vars rewrite_list closures
diff --git a/compiler/tests-jsoo/gh1007.ml b/compiler/tests-jsoo/gh1007.ml
index ea15f21d42..69b26ce2d8 100644
--- a/compiler/tests-jsoo/gh1007.ml
+++ b/compiler/tests-jsoo/gh1007.ml
@@ -103,5 +103,4 @@ let rec f x =
 
 let%expect_test _ =
   f (Node Empty);
-  [%expect.unreachable]
-[@@expect.uncaught_exn {| (Failure "TypeError: rev_sort is not a function") |}]
+  [%expect{||}]

From 76fce732841e3038dfbed5a493124baae55393c1 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Fri, 1 May 2020 13:49:28 +0200
Subject: [PATCH 3/6] Tests: move gh1007 to test-compiler

---
 compiler/tests-compiler/gh1007.ml | 350 ++++++++++++++++++++++++++++++
 compiler/tests-jsoo/gh1007.ml     | 106 ---------
 compiler/tests-jsoo/gh1007.mli    |   1 -
 3 files changed, 350 insertions(+), 107 deletions(-)
 create mode 100644 compiler/tests-compiler/gh1007.ml
 delete mode 100644 compiler/tests-jsoo/gh1007.ml
 delete mode 100644 compiler/tests-jsoo/gh1007.mli

diff --git a/compiler/tests-compiler/gh1007.ml b/compiler/tests-compiler/gh1007.ml
new file mode 100644
index 0000000000..ec9a870ebf
--- /dev/null
+++ b/compiler/tests-compiler/gh1007.ml
@@ -0,0 +1,350 @@
+(* Js_of_ocaml tests
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+(* https://github.com/ocsigen/js_of_ocaml/issues/1007 *)
+
+(* There was a bad interaction between the code generating trampoline
+   for recursive functions and the code responsible for capturing
+   mutable variable in closures.
+
+   In practice, the issue would trigger when mutually recursives
+   functions, where recursion is not in tail position, appear inside a
+   for-loop.
+
+   In the test below, [f] compiles into a for loop and
+   [MyList.stable_sort] gets inlined.  *)
+
+let%expect_test _ =
+  let prog =
+    {|
+module M : sig
+  type t
+  val myfun : t -> unit
+  val x : t
+end = struct
+  module MyList : sig
+    val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+  end = struct
+    let rec length_aux len = function
+      | [] -> len
+      | _ :: l -> length_aux (len + 1) l
+
+    let length l = length_aux 0 l
+
+    let rec rev_append l1 l2 =
+      match l1 with
+      | [] -> l2
+      | a :: l -> rev_append l (a :: l2)
+
+    let stable_sort cmp l =
+      let rec rev_merge l1 l2 accu =
+        match l1, l2 with
+        | [], l2 -> rev_append l2 accu
+        | l1, [] -> rev_append l1 accu
+        | h1 :: t1, h2 :: t2 ->
+          if cmp h1 h2 <= 0
+          then rev_merge t1 l2 (h1 :: accu)
+          else rev_merge l1 t2 (h2 :: accu)
+      in
+      let rec rev_merge_rev l1 l2 accu =
+        match l1, l2 with
+        | [], l2 -> rev_append l2 accu
+        | l1, [] -> rev_append l1 accu
+        | h1 :: t1, h2 :: t2 ->
+          if cmp h1 h2 > 0
+          then rev_merge_rev t1 l2 (h1 :: accu)
+          else rev_merge_rev l1 t2 (h2 :: accu)
+      in
+      let rec sort n l =
+        match n, l with
+        | 2, x1 :: x2 :: tl ->
+          let s = if cmp x1 x2 <= 0 then [ x1; x2 ] else [ x2; x1 ] in
+          s, tl
+        | 3, x1 :: x2 :: x3 :: tl ->
+          let s =
+            if cmp x1 x2 <= 0
+            then
+              if cmp x2 x3 <= 0
+              then [ x1; x2; x3 ]
+              else if cmp x1 x3 <= 0
+              then [ x1; x3; x2 ]
+              else [ x3; x1; x2 ]
+            else if cmp x1 x3 <= 0
+            then [ x2; x1; x3 ]
+            else if cmp x2 x3 <= 0
+            then [ x2; x3; x1 ]
+            else [ x3; x2; x1 ]
+          in
+          s, tl
+        | n, l ->
+          let n1 = n asr 1 in
+          let n2 = n - n1 in
+          let s1, l2 = rev_sort n1 l in
+          let s2, tl = rev_sort n2 l2 in
+          rev_merge_rev s1 s2 [], tl
+      and rev_sort n l =
+        match n, l with
+        | 2, x1 :: x2 :: tl ->
+          let s = if cmp x1 x2 > 0 then [ x1; x2 ] else [ x2; x1 ] in
+          s, tl
+        | 3, x1 :: x2 :: x3 :: tl ->
+          let s =
+            if cmp x1 x2 > 0
+            then
+              if cmp x2 x3 > 0
+              then [ x1; x2; x3 ]
+              else if cmp x1 x3 > 0
+              then [ x1; x3; x2 ]
+              else [ x3; x1; x2 ]
+            else if cmp x1 x3 > 0
+            then [ x2; x1; x3 ]
+            else if cmp x2 x3 > 0
+            then [ x2; x3; x1 ]
+            else [ x3; x2; x1 ]
+          in
+          s, tl
+        | n, l ->
+          let n1 = n asr 1 in
+          let n2 = n - n1 in
+          let s1, l2 = sort n1 l in
+          let s2, tl = sort n2 l2 in
+          rev_merge s1 s2 [], tl
+      in
+      let len = length l in
+      if len < 2 then l else fst (sort len l)
+  end
+
+  type t =
+    | Empty
+    | Node of t
+
+  let rec myfun x =
+    match x with
+    | Empty -> ()
+    | Node next ->
+      let _ = MyList.stable_sort compare [ 1; 2; 3; 4 ] in
+      myfun next
+
+  let x = Node Empty
+
+end
+
+let ()  = M.myfun M.x
+|}
+  in
+  Util.compile_and_run prog;
+  [%expect {| |}];
+  let program = Util.compile_and_parse prog in
+  Util.print_fun_decl program (Some "myfun");
+  [%expect
+    {|
+    function myfun(x)
+     {var x$0=x;
+      a:
+      for(;;)
+       {if(x$0)
+         {var
+           next=x$0[1],
+           rev_sort=
+            function(n,l)
+             {if(2 === n)
+               {if(l)
+                 {var _e_=l[2];
+                  if(_e_)
+                   {var
+                     tl=_e_[2],
+                     x2=_e_[1],
+                     x1=l[1],
+                     s=0 < caml_int_compare(x1,x2)?[0,x1,[0,x2,0]]:[0,x2,[0,x1,0]];
+                    return [0,s,tl]}}}
+              else
+               if(3 === n && l)
+                {var _g_=l[2];
+                 if(_g_)
+                  {var _h_=_g_[2];
+                   if(_h_)
+                    {var
+                      tl$1=_h_[2],
+                      x3=_h_[1],
+                      x2$0=_g_[1],
+                      x1$0=l[1],
+                      s$0=
+                       0 < caml_int_compare(x1$0,x2$0)
+                        ?0 < caml_int_compare(x2$0,x3)
+                          ?[0,x1$0,[0,x2$0,[0,x3,0]]]
+                          :0 < caml_int_compare(x1$0,x3)
+                            ?[0,x1$0,[0,x3,[0,x2$0,0]]]
+                            :[0,x3,[0,x1$0,[0,x2$0,0]]]
+                        :0 < caml_int_compare(x1$0,x3)
+                          ?[0,x2$0,[0,x1$0,[0,x3,0]]]
+                          :0 < caml_int_compare(x2$0,x3)
+                            ?[0,x2$0,[0,x3,[0,x1$0,0]]]
+                            :[0,x3,[0,x2$0,[0,x1$0,0]]];
+                     return [0,s$0,tl$1]}}}
+              var
+               n1=n >> 1,
+               n2=n - n1 | 0,
+               match=sort(n1,l),
+               l2$0=match[2],
+               s1=match[1],
+               match$0=sort(n2,l2$0),
+               tl$0=match$0[2],
+               s2=match$0[1],
+               l1=s1,
+               l2=s2,
+               accu=0;
+              for(;;)
+               {if(l1)
+                 {if(l2)
+                   {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;continue}
+                    var accu$1=[0,h1,accu],l1=t1,accu=accu$1;
+                    continue}
+                  var _f_=rev_append(l1,accu)}
+                else
+                 var _f_=rev_append(l2,accu);
+                return [0,_f_,tl$0]}},
+           sort=
+            function(n,l)
+             {if(2 === n)
+               {if(l)
+                 {var _a_=l[2];
+                  if(_a_)
+                   {var
+                     tl=_a_[2],
+                     x2=_a_[1],
+                     x1=l[1],
+                     s=0 < caml_int_compare(x1,x2)?[0,x2,[0,x1,0]]:[0,x1,[0,x2,0]];
+                    return [0,s,tl]}}}
+              else
+               if(3 === n && l)
+                {var _c_=l[2];
+                 if(_c_)
+                  {var _d_=_c_[2];
+                   if(_d_)
+                    {var
+                      tl$1=_d_[2],
+                      x3=_d_[1],
+                      x2$0=_c_[1],
+                      x1$0=l[1],
+                      s$0=
+                       0 < caml_int_compare(x1$0,x2$0)
+                        ?0 < caml_int_compare(x1$0,x3)
+                          ?0 < caml_int_compare(x2$0,x3)
+                            ?[0,x3,[0,x2$0,[0,x1$0,0]]]
+                            :[0,x2$0,[0,x3,[0,x1$0,0]]]
+                          :[0,x2$0,[0,x1$0,[0,x3,0]]]
+                        :0 < caml_int_compare(x2$0,x3)
+                          ?0 < caml_int_compare(x1$0,x3)
+                            ?[0,x3,[0,x1$0,[0,x2$0,0]]]
+                            :[0,x1$0,[0,x3,[0,x2$0,0]]]
+                          :[0,x1$0,[0,x2$0,[0,x3,0]]];
+                     return [0,s$0,tl$1]}}}
+              var
+               n1=n >> 1,
+               n2=n - n1 | 0,
+               match=rev_sort(n1,l),
+               l2$0=match[2],
+               s1=match[1],
+               match$0=rev_sort(n2,l2$0),
+               tl$0=match$0[2],
+               s2=match$0[1],
+               l1=s1,
+               l2=s2,
+               accu=0;
+              for(;;)
+               {if(l1)
+                 {if(l2)
+                   {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;continue}
+                    var accu$1=[0,h2,accu],l2=t2,accu=accu$1;
+                    continue}
+                  var _b_=rev_append(l1,accu)}
+                else
+                 var _b_=rev_append(l2,accu);
+                return [0,_b_,tl$0]}},
+           len=0,
+           param=l;
+          for(;;)
+           {if(param)
+             {var param$0=param[2],len$0=len + 1 | 0,len=len$0,param=param$0;
+              continue}
+            if(2 <= len)sort(len,l);
+            var x$0=next;
+            continue a}}
+        return 0}} |}]
+
+let%expect_test _ =
+  let prog =
+    {|
+module M : sig
+  val run : unit -> unit
+end = struct
+  let even i =
+    let rec odd = function
+     | 0 -> false
+     | 1 -> not (not (even 0))
+     | 2 -> not (not (even 1))
+     | n -> not (not (even (n - 1)))
+    and even = function
+     | 0 -> true
+     | 1 -> not (not (odd 0))
+     | 2 -> not (not (odd 1))
+     | n -> not (not (odd (n - 1)))
+    in even i
+
+ let run () =
+   for i = 0 to 10 do
+     ignore (even (i) : bool)
+   done
+end
+
+let ()  = M.run ()
+|}
+  in
+  Util.compile_and_run prog;
+  [%expect {| |}];
+  let program = Util.compile_and_parse prog in
+  Util.print_fun_decl program (Some "run");
+  [%expect
+    {|
+    function run(param)
+     {var i=0;
+      for(;;)
+       {var
+         even=
+          function(n)
+           {if(2 < n >>> 0)return 1 - (1 - odd(n - 1 | 0));
+            switch(n)
+             {case 0:return 1;
+              case 1:return 1 - (1 - odd(0));
+              default:return 1 - (1 - odd(1))}},
+         odd=
+          function(n)
+           {if(2 < n >>> 0)return 1 - (1 - even(n - 1 | 0));
+            switch(n)
+             {case 0:return 0;
+              case 1:return 1 - (1 - even(0));
+              default:return 1 - (1 - even(1))}};
+        even(i);
+        var _a_=i + 1 | 0;
+        if(10 !== i){var i=_a_;continue}
+        return 0}} |}]
diff --git a/compiler/tests-jsoo/gh1007.ml b/compiler/tests-jsoo/gh1007.ml
deleted file mode 100644
index 69b26ce2d8..0000000000
--- a/compiler/tests-jsoo/gh1007.ml
+++ /dev/null
@@ -1,106 +0,0 @@
-module MyList : sig
-  val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
-end = struct
-  let rec length_aux len = function
-    | [] -> len
-    | _ :: l -> length_aux (len + 1) l
-
-  let length l = length_aux 0 l
-
-  let rec rev_append l1 l2 =
-    match l1 with
-    | [] -> l2
-    | a :: l -> rev_append l (a :: l2)
-
-  let stable_sort cmp l =
-    let rec rev_merge l1 l2 accu =
-      match l1, l2 with
-      | [], l2 -> rev_append l2 accu
-      | l1, [] -> rev_append l1 accu
-      | h1 :: t1, h2 :: t2 ->
-          if cmp h1 h2 <= 0
-          then rev_merge t1 l2 (h1 :: accu)
-          else rev_merge l1 t2 (h2 :: accu)
-    in
-    let rec rev_merge_rev l1 l2 accu =
-      match l1, l2 with
-      | [], l2 -> rev_append l2 accu
-      | l1, [] -> rev_append l1 accu
-      | h1 :: t1, h2 :: t2 ->
-          if cmp h1 h2 > 0
-          then rev_merge_rev t1 l2 (h1 :: accu)
-          else rev_merge_rev l1 t2 (h2 :: accu)
-    in
-    let rec sort n l =
-      match n, l with
-      | 2, x1 :: x2 :: tl ->
-          let s = if cmp x1 x2 <= 0 then [ x1; x2 ] else [ x2; x1 ] in
-          s, tl
-      | 3, x1 :: x2 :: x3 :: tl ->
-          let s =
-            if cmp x1 x2 <= 0
-            then
-              if cmp x2 x3 <= 0
-              then [ x1; x2; x3 ]
-              else if cmp x1 x3 <= 0
-              then [ x1; x3; x2 ]
-              else [ x3; x1; x2 ]
-            else if cmp x1 x3 <= 0
-            then [ x2; x1; x3 ]
-            else if cmp x2 x3 <= 0
-            then [ x2; x3; x1 ]
-            else [ x3; x2; x1 ]
-          in
-          s, tl
-      | n, l ->
-          let n1 = n asr 1 in
-          let n2 = n - n1 in
-          let s1, l2 = rev_sort n1 l in
-          let s2, tl = rev_sort n2 l2 in
-          rev_merge_rev s1 s2 [], tl
-    and rev_sort n l =
-      match n, l with
-      | 2, x1 :: x2 :: tl ->
-          let s = if cmp x1 x2 > 0 then [ x1; x2 ] else [ x2; x1 ] in
-          s, tl
-      | 3, x1 :: x2 :: x3 :: tl ->
-          let s =
-            if cmp x1 x2 > 0
-            then
-              if cmp x2 x3 > 0
-              then [ x1; x2; x3 ]
-              else if cmp x1 x3 > 0
-              then [ x1; x3; x2 ]
-              else [ x3; x1; x2 ]
-            else if cmp x1 x3 > 0
-            then [ x2; x1; x3 ]
-            else if cmp x2 x3 > 0
-            then [ x2; x3; x1 ]
-            else [ x3; x2; x1 ]
-          in
-          s, tl
-      | n, l ->
-          let n1 = n asr 1 in
-          let n2 = n - n1 in
-          let s1, l2 = sort n1 l in
-          let s2, tl = sort n2 l2 in
-          rev_merge s1 s2 [], tl
-    in
-    let len = length l in
-    if len < 2 then l else fst (sort len l)
-end
-
-type t =
-  | Empty
-  | Node of t
-
-let rec f x =
-  match x with
-  | Empty -> ()
-  | Node next ->
-      let _ = MyList.stable_sort compare [ 1; 2; 3; 4 ] in
-      f next
-
-let%expect_test _ =
-  f (Node Empty);
-  [%expect{||}]
diff --git a/compiler/tests-jsoo/gh1007.mli b/compiler/tests-jsoo/gh1007.mli
deleted file mode 100644
index 6837f68b31..0000000000
--- a/compiler/tests-jsoo/gh1007.mli
+++ /dev/null
@@ -1 +0,0 @@
-(* Empty *)

From 4ddd0a1b9663717143dabe8ca1218d2411664dd7 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Fri, 1 May 2020 13:51:54 +0200
Subject: [PATCH 4/6] Misc: don't reformat in tests-re

---
 compiler/tests-re/.ocamlformat | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 compiler/tests-re/.ocamlformat

diff --git a/compiler/tests-re/.ocamlformat b/compiler/tests-re/.ocamlformat
new file mode 100644
index 0000000000..36a8f9d2f6
--- /dev/null
+++ b/compiler/tests-re/.ocamlformat
@@ -0,0 +1 @@
+disable
\ No newline at end of file

From 68bdfb976aaff284ea3ae80821e1600fe39be51d Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Fri, 1 May 2020 14:09:29 +0200
Subject: [PATCH 5/6] Changes

---
 CHANGES.md | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 3c9ef462de..a0115df7af 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,4 +1,8 @@
 # dev (????-??-??) - Somewhere
+## Features/Changes
+
+## Bug fixes
+* Compiler: fix code generation for recursive function under for-loops (#1009)
 
 # 3.6.0 (2020-04-26) - Lille
 ## Features/Changes

From 67abdecfc90c32a19bacf5f3b27348034ea7d315 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Sun, 3 May 2020 15:39:31 +0200
Subject: [PATCH 6/6] Tests: add more

---
 compiler/lib/generate_closure.ml  |  11 +-
 compiler/tests-compiler/gh1007.ml | 210 +++++++++++++++++++++++++++++-
 2 files changed, 215 insertions(+), 6 deletions(-)

diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml
index 06727fdba0..ec834a81cf 100644
--- a/compiler/lib/generate_closure.ml
+++ b/compiler/lib/generate_closure.ml
@@ -57,11 +57,14 @@ let rec collect_apply pc blocks visited tc ntc =
           | Some _ -> None)
       | _ -> None
     in
-    let ntc =
-      List.fold_left block.body ~init:ntc ~f:(fun acc x ->
+    let visited, ntc =
+      List.fold_left block.body ~init:(visited, ntc) ~f:(fun (visited, acc) x ->
           match x with
-          | Let (_, Apply (z, _, _)) -> add_multi z pc acc
-          | _ -> acc)
+          | Let (_, Apply (z, _, _)) -> visited, add_multi z pc acc
+          | Let (_, Closure (_, (pc, _))) ->
+              let visited, _tc, ntc = collect_apply pc blocks visited tc ntc in
+              visited, ntc
+          | _ -> visited, acc)
     in
     match tc_opt with
     | Some tc -> visited, tc, ntc
diff --git a/compiler/tests-compiler/gh1007.ml b/compiler/tests-compiler/gh1007.ml
index ec9a870ebf..b182e5f450 100644
--- a/compiler/tests-compiler/gh1007.ml
+++ b/compiler/tests-compiler/gh1007.ml
@@ -312,7 +312,7 @@ end = struct
     in even i
 
  let run () =
-   for i = 0 to 10 do
+   for i = 0 to 4 do
      ignore (even (i) : bool)
    done
 end
@@ -346,5 +346,211 @@ let ()  = M.run ()
               default:return 1 - (1 - even(1))}};
         even(i);
         var _a_=i + 1 | 0;
-        if(10 !== i){var i=_a_;continue}
+        if(4 !== i){var i=_a_;continue}
         return 0}} |}]
+
+let%expect_test _ =
+  let prog =
+    {|
+module M : sig
+  val run : unit -> unit
+end = struct
+  let delayed = ref []
+  let even i =
+    let rec odd = function
+     | 0 ->
+       let f () = Printf.printf "in odd, called with %d\n" i in
+       delayed := f :: !delayed;
+       f ();
+       false
+     | 1 -> not (not (even 0))
+     | 2 -> not (not (even 1))
+     | n -> not (not (even (n - 1)))
+    and even = function
+     | 0 ->
+       let f () = Printf.printf "in even, called with %d\n" i in
+       delayed := f :: !delayed;
+       f ();
+       true
+     | 1 -> not (not (odd 0))
+     | 2 -> not (not (odd 1))
+     | n -> not (not (odd (n - 1)))
+    in even i
+
+ let run () =
+   for i = 0 to 4 do
+     ignore (even (i) : bool)
+   done;
+   List.iter (fun f -> f ()) (List.rev !delayed)
+end
+
+let ()  = M.run ()
+|}
+  in
+  Util.compile_and_run prog;
+  [%expect
+    {|
+    in even, called with 0
+    in odd, called with 1
+    in even, called with 2
+    in odd, called with 3
+    in even, called with 4
+    in even, called with 0
+    in odd, called with 1
+    in even, called with 2
+    in odd, called with 3
+    in even, called with 4 |}];
+  let program = Util.compile_and_parse prog in
+  Util.print_fun_decl program (Some "run");
+  [%expect
+    {|
+    function run(param)
+     {var i=0;
+      for(;;)
+       {var
+         closures=
+          function(i)
+           {function even(n)
+             {if(2 < n >>> 0)return 1 - (1 - odd(n - 1 | 0));
+              switch(n)
+               {case 0:
+                 var f=function(param){return caml_call2(Stdlib_printf[2],_b_,i)};
+                 delayed[1] = [0,f,delayed[1]];
+                 f(0);
+                 return 1;
+                case 1:return 1 - (1 - odd(0));
+                default:return 1 - (1 - odd(1))}}
+            function odd(n)
+             {if(2 < n >>> 0)return 1 - (1 - even(n - 1 | 0));
+              switch(n)
+               {case 0:
+                 var f=function(param){return caml_call2(Stdlib_printf[2],_a_,i)};
+                 delayed[1] = [0,f,delayed[1]];
+                 f(0);
+                 return 0;
+                case 1:return 1 - (1 - even(0));
+                default:return 1 - (1 - even(1))}}
+            var block=[0,even,odd];
+            return block},
+         closures$0=closures(i),
+         even=closures$0[1];
+        even(i);
+        var _e_=i + 1 | 0;
+        if(4 !== i){var i=_e_;continue}
+        var
+         _c_=caml_call1(Stdlib_list[9],delayed[1]),
+         _d_=function(f){return caml_call1(f,0)};
+        return caml_call2(Stdlib_list[15],_d_,_c_)}} |}]
+
+let%expect_test _ =
+  let prog =
+    {|
+module M : sig
+  val run : unit -> unit
+end = struct
+  let delayed = ref []
+  let even i =
+    let rec odd = function
+     | 0 -> `Cont (fun () ->
+       let f () = Printf.printf "in odd, called with %d\n" i in
+       delayed := f :: !delayed;
+       f ();
+       `Done false)
+     | 1 -> `Cont (fun () -> even 0)
+     | 2 -> `Cont (fun () -> even 1)
+     | n -> `Cont (fun () -> even (n - 1))
+    and even = function
+     | 0 -> `Cont (fun () ->
+       let f () = Printf.printf "in even, called with %d\n" i in
+       delayed := f :: !delayed;
+       f ();
+       `Done true)
+     | 1 -> `Cont (fun () -> odd 0)
+     | 2 -> `Cont (fun () -> odd 1)
+     | n -> `Cont (fun () -> odd (n - 1))
+    in even i
+
+ let run () =
+   for i = 0 to 4 do
+      let rec r = function
+        | `Done x -> x
+        | `Cont f -> r (f ())
+      in
+      ignore (r  (even (i)) : bool)
+   done;
+   List.iter (fun f -> f ()) (List.rev !delayed)
+end
+
+let ()  = M.run ()
+|}
+  in
+  Util.compile_and_run prog;
+  [%expect
+    {|
+    in even, called with 0
+    in odd, called with 1
+    in even, called with 2
+    in odd, called with 3
+    in even, called with 4
+    in even, called with 0
+    in odd, called with 1
+    in even, called with 2
+    in odd, called with 3
+    in even, called with 4 |}];
+  let program = Util.compile_and_parse prog in
+  Util.print_fun_decl program (Some "run");
+  [%expect
+    {|
+    function run(param$0)
+     {var i=0;
+      a:
+      for(;;)
+       {var
+         closures=
+          function(i)
+           {function even(n)
+             {if(2 < n >>> 0)
+               return [0,748545554,function(param){return odd(n - 1 | 0)}];
+              switch(n)
+               {case 0:
+                 return [0,
+                         748545554,
+                         function(param)
+                          {function f(param)
+                            {return caml_call2(Stdlib_printf[2],_c_,i)}
+                           delayed[1] = [0,f,delayed[1]];
+                           f(0);
+                           return _d_}];
+                case 1:return [0,748545554,function(param){return odd(0)}];
+                default:return [0,748545554,function(param){return odd(1)}]}}
+            function odd(n)
+             {if(2 < n >>> 0)
+               return [0,748545554,function(param){return even(n - 1 | 0)}];
+              switch(n)
+               {case 0:
+                 return [0,
+                         748545554,
+                         function(param)
+                          {function f(param)
+                            {return caml_call2(Stdlib_printf[2],_a_,i)}
+                           delayed[1] = [0,f,delayed[1]];
+                           f(0);
+                           return _b_}];
+                case 1:return [0,748545554,function(param){return even(0)}];
+                default:return [0,748545554,function(param){return even(1)}]}}
+            var block=[0,even,odd];
+            return block},
+         closures$0=closures(i),
+         even=closures$0[1],
+         param=even(i),
+         param$1=param;
+        for(;;)
+         {if(759635106 <= param$1[1])
+           {var _g_=i + 1 | 0;
+            if(4 !== i){var i=_g_;continue a}
+            var
+             _e_=caml_call1(Stdlib_list[9],delayed[1]),
+             _f_=function(f){return caml_call1(f,0)};
+            return caml_call2(Stdlib_list[15],_f_,_e_)}
+          var f=param$1[2],param$2=caml_call1(f,0),param$1=param$2;
+          continue}}} |}]