diff --git a/jscomp/lam_beta_reduce.ml b/jscomp/lam_beta_reduce.ml index 9afeb981ec..f1bbbf5f72 100644 --- a/jscomp/lam_beta_reduce.ml +++ b/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) -> diff --git a/jscomp/test/.depend b/jscomp/test/.depend index d80177f5bf..0618ec9ba4 100644 --- a/jscomp/test/.depend +++ b/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 \ diff --git a/jscomp/test/gpr_405_test.ml b/jscomp/test/gpr_405_test.ml new file mode 100644 index 0000000000..83e20927a7 --- /dev/null +++ b/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 diff --git a/jscomp/test/gpr_405_test.mli b/jscomp/test/gpr_405_test.mli new file mode 100644 index 0000000000..28cae73624 --- /dev/null +++ b/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 diff --git a/jscomp/test/test.mllib b/jscomp/test/test.mllib index 96f66f11e6..751bb1bf32 100644 --- a/jscomp/test/test.mllib +++ b/jscomp/test/test.mllib @@ -305,4 +305,5 @@ ignore_test test_index obj_literal_ppx_test -obj_literal_ppx \ No newline at end of file +obj_literal_ppx +gpr_405_test \ No newline at end of file diff --git a/lib/js/test/gpr_405_test.js b/lib/js/test/gpr_405_test.js new file mode 100644 index 0000000000..763993b473 --- /dev/null +++ b/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 */