[fix] fix issue #405

jscomp/lam_beta_reduce.ml

@@ -94,11 +94,9 @@ let rewrite (map :   (Ident.t, _) Hashtbl.t)
       let l2 = aux l2 in
       Llet(str, v,  l1,  l2 )
     | Lletrec(bindings, body) ->
-      let bindings = 
-        bindings |> List.map (fun (k,l) ->  
-            let k = rebind k in
-            (k, aux l)
-          )  in 
+      (*order matters see GPR #405*)
+      let vars = List.map (fun (k, _) -> rebind k) bindings in 
+      let bindings = List.map2 (fun var (_,l) -> var, aux l) vars bindings in 
       let body = aux body in       
       Lletrec(bindings, body) 
     | Lfunction(kind, params, body) -> 

jscomp/test/.depend

@@ -8,6 +8,7 @@ demo_int_map.cmi :
 ext_pervasives.cmi : ../stdlib/int32.cmi ../stdlib/format.cmi
 ext_sys.cmi :
 float_record.cmi :
+gpr_405_test.cmi :
 inline_edge_cases.cmi :
 inline_map_test.cmi :
 map_test.cmi :
@@ -210,6 +211,8 @@ global_exception_regression_test.cmj : mt.cmi
 global_exception_regression_test.cmx : mt.cmx
 google_closure_test.cmj : test_google_closure.cmj mt.cmi
 google_closure_test.cmx : test_google_closure.cmx mt.cmx
+gpr_405_test.cmj : ../stdlib/hashtbl.cmi gpr_405_test.cmi
+gpr_405_test.cmx : ../stdlib/hashtbl.cmx gpr_405_test.cmi
 guide_for_ext.cmj :
 guide_for_ext.cmx :
 hamming_test.cmj : ../stdlib/printf.cmi mt.cmi ../stdlib/lazy.cmi \
@@ -858,6 +861,8 @@ global_exception_regression_test.cmo : mt.cmi
 global_exception_regression_test.cmj : mt.cmj
 google_closure_test.cmo : test_google_closure.cmo mt.cmi
 google_closure_test.cmj : test_google_closure.cmj mt.cmj
+gpr_405_test.cmo : ../stdlib/hashtbl.cmi gpr_405_test.cmi
+gpr_405_test.cmj : ../stdlib/hashtbl.cmj gpr_405_test.cmi
 guide_for_ext.cmo :
 guide_for_ext.cmj :
 hamming_test.cmo : ../stdlib/printf.cmi mt.cmi ../stdlib/lazy.cmi \

jscomp/test/gpr_405_test.ml

@@ -0,0 +1,95 @@
+
+module type G = sig
+  type t
+  module V : sig
+
+    (** Vertices are {!COMPARABLE}. *)
+
+    type t
+
+    val compare : t -> t -> int
+    val hash : t -> int
+    val equal : t -> t -> bool
+
+    type label
+    val create : label -> t
+    val label : t -> label
+
+  end
+  val succ : t -> V.t -> V.t list
+end
+
+module Make (G : G) = struct
+
+  module H = Hashtbl.Make (G.V)
+
+  let find_default htbl x =
+    try H.find htbl x
+    with Not_found -> false
+
+  let min_cutset gr first_node =
+    let n_labels = H.create 97 in
+    let l_labels = H.create 97 in
+
+    let already_processed = H.create 97 in
+    let is_already_processed x = find_default already_processed x in
+
+    let on_the_stack = H.create 97 in
+    let is_on_the_stack x = find_default on_the_stack x in
+    let cut_set = ref [] in
+    let counter = ref 1 in
+
+    let rec step2 top rest_of_stack =
+      assert (not (is_already_processed top));
+      assert (not (is_on_the_stack top));
+      H.add on_the_stack top true;
+      H.add n_labels top !counter;
+      counter := !counter + 1;
+      H.add l_labels top 0;
+      H.add already_processed top true;
+      step3 (G.succ gr top) top rest_of_stack
+
+    and step3 successors top rest_of_stack = match successors with
+      | successor :: other_successors ->
+        if not (is_already_processed successor)
+        (* step 4 *)
+        then step2 successor ((top,successors)::rest_of_stack)
+        (* step 5 *)
+        else begin
+          let x =
+            if is_on_the_stack successor
+            then H.find n_labels successor
+            else H.find l_labels successor
+          in
+          H.add l_labels top
+            (max (H.find l_labels top) x) ;
+          step3 other_successors top rest_of_stack
+        end
+
+      | [] -> begin
+          (* step 7 *)
+          if H.find l_labels top = H.find n_labels top
+          then begin
+            cut_set := top::!cut_set ;
+            H.add l_labels top 0 ;
+          end ;
+
+          (* check added between algorithms C and D *)
+          if H.find l_labels top > H.find n_labels top
+          then raise (Invalid_argument "Graph.Mincut: graph not reducible")
+
+          (* step 8 *)
+          else match rest_of_stack with
+            | [] -> !cut_set (* SUCCESS *)
+            | (new_top, new_successors)::new_tail -> begin
+                H.add on_the_stack top false;
+                H.add l_labels new_top
+                  (max (H.find l_labels top) (H.find l_labels new_top)) ;
+                step3 new_successors new_top new_tail
+              end
+        end in
+
+    (* step 2 *)
+    step2 first_node []
+
+end

jscomp/test/gpr_405_test.mli

@@ -0,0 +1,26 @@
+
+module type G = sig
+  type t
+  module V : sig
+
+    (** Vertices are {!COMPARABLE}. *)
+
+    type t
+
+    val compare : t -> t -> int
+    val hash : t -> int
+    val equal : t -> t -> bool
+
+    type label
+    val create : label -> t
+    val label : t -> label
+
+  end
+  val succ : t -> V.t -> V.t list
+end
+
+module Make (G : G) : sig
+
+  val min_cutset : G.t -> G.V.t -> G.V.t list
+
+end

jscomp/test/test.mllib

@@ -305,4 +305,5 @@ ignore_test
 test_index
 
 obj_literal_ppx_test
-obj_literal_ppx
+obj_literal_ppx
+gpr_405_test

lib/js/test/gpr_405_test.js

@@ -0,0 +1,124 @@
+// GENERATED CODE BY BUCKLESCRIPT VERSION 0.5.0 , PLEASE EDIT WITH CARE
+'use strict';
+
+var Caml_builtin_exceptions = require("../caml_builtin_exceptions");
+var Hashtbl                 = require("../hashtbl");
+var Pervasives              = require("../pervasives");
+var Curry                   = require("../curry");
+
+function Make(funarg) {
+  var $$let = funarg[/* V */0];
+  var H = Hashtbl.Make([
+        $$let[2],
+        $$let[1]
+      ]);
+  var find_default = function (htbl, x) {
+    try {
+      return Curry._2(H[/* find */6], htbl, x);
+    }
+    catch (exn){
+      if (exn === Caml_builtin_exceptions.not_found) {
+        return /* false */0;
+      }
+      else {
+        throw exn;
+      }
+    }
+  };
+  var min_cutset = function (gr, first_node) {
+    var n_labels = Curry._1(H[/* create */0], 97);
+    var l_labels = Curry._1(H[/* create */0], 97);
+    var already_processed = Curry._1(H[/* create */0], 97);
+    var on_the_stack = Curry._1(H[/* create */0], 97);
+    var cut_set = [/* [] */0];
+    var counter = [1];
+    var step2 = function (top, rest_of_stack) {
+      if (find_default(already_processed, top)) {
+        throw [
+              Caml_builtin_exceptions.assert_failure,
+              [
+                "gpr_405_test.ml",
+                43,
+                6
+              ]
+            ];
+      }
+      if (find_default(on_the_stack, top)) {
+        throw [
+              Caml_builtin_exceptions.assert_failure,
+              [
+                "gpr_405_test.ml",
+                44,
+                6
+              ]
+            ];
+      }
+      Curry._3(H[/* add */4], on_the_stack, top, /* true */1);
+      Curry._3(H[/* add */4], n_labels, top, counter[0]);
+      counter[0] = counter[0] + 1 | 0;
+      Curry._3(H[/* add */4], l_labels, top, 0);
+      Curry._3(H[/* add */4], already_processed, top, /* true */1);
+      var _successors = Curry._2(funarg[/* succ */1], gr, top);
+      var _top = top;
+      var _rest_of_stack = rest_of_stack;
+      while(true) {
+        var rest_of_stack$1 = _rest_of_stack;
+        var top$1 = _top;
+        var successors = _successors;
+        if (successors) {
+          var successor = successors[0];
+          if (find_default(already_processed, successor)) {
+            var x = find_default(on_the_stack, successor) ? Curry._2(H[/* find */6], n_labels, successor) : Curry._2(H[/* find */6], l_labels, successor);
+            Curry._3(H[/* add */4], l_labels, top$1, Pervasives.max(Curry._2(H[/* find */6], l_labels, top$1), x));
+            _successors = successors[1];
+            continue ;
+
+          }
+          else {
+            return step2(successor, /* :: */[
+                        /* tuple */[
+                          top$1,
+                          successors
+                        ],
+                        rest_of_stack$1
+                      ]);
+          }
+        }
+        else {
+          if (Curry._2(H[/* find */6], l_labels, top$1) === Curry._2(H[/* find */6], n_labels, top$1)) {
+            cut_set[0] = /* :: */[
+              top$1,
+              cut_set[0]
+            ];
+            Curry._3(H[/* add */4], l_labels, top$1, 0);
+          }
+          if (Curry._2(H[/* find */6], l_labels, top$1) > Curry._2(H[/* find */6], n_labels, top$1)) {
+            throw [
+                  Caml_builtin_exceptions.invalid_argument,
+                  "Graph.Mincut: graph not reducible"
+                ];
+          }
+          else if (rest_of_stack$1) {
+            var match = rest_of_stack$1[0];
+            var new_top = match[0];
+            Curry._3(H[/* add */4], on_the_stack, top$1, /* false */0);
+            Curry._3(H[/* add */4], l_labels, new_top, Pervasives.max(Curry._2(H[/* find */6], l_labels, top$1), Curry._2(H[/* find */6], l_labels, new_top)));
+            _rest_of_stack = rest_of_stack$1[1];
+            _top = new_top;
+            _successors = match[1];
+            continue ;
+
+          }
+          else {
+            return cut_set[0];
+          }
+        }
+      };
+    };
+    return step2(first_node, /* [] */0);
+  };
+  return [min_cutset];
+}
+
+exports.Make = Make;
+/* Hashtbl Not a pure module */