fix rescript-lang#1749

Author: bobzhang

.github/CHECK_LIST.md

@@ -1,3 +1,5 @@
+Before a bug report, please confirm if it is reproducible in master, we fix bugs quickly, so it may already be fixed in master.
+
 ## Checklist
 
   * [x] Does your title concisely summarize the problem?

jscomp/bin/whole_compiler.ml

@@ -96767,8 +96767,8 @@ and
               | {block = []; value =  Some out1},
                 {block = []; value =  Some out2} ->  
                 (* Invariant: should_return is false*)
-                Js_output.make [
-                  S.define ~kind id (E.econd e out1 out2) ]
+                Js_output.make @@ (b @ [
+                  S.define ~kind id (E.econd e out1 out2) ])
               | _, _ -> 
                 Js_output.make 
                   ( b @ [

jscomp/core/lam_compile.ml

@@ -971,8 +971,8 @@ and
               | {block = []; value =  Some out1},
                 {block = []; value =  Some out2} ->  
                 (* Invariant: should_return is false*)
-                Js_output.make [
-                  S.define ~kind id (E.econd e out1 out2) ]
+                Js_output.make @@ (b @ [
+                  S.define ~kind id (E.econd e out1 out2) ])
               | _, _ -> 
                 Js_output.make 
                   ( b @ [

jscomp/core/lam_compile_group.ml

@@ -385,7 +385,7 @@ let lambda_as_module
   begin 
     Js_config.set_current_file filename ;  
 #if BS_DEBUG then    
-    Js_config.set_debug_file "rec_fun_test.ml";
+    Js_config.set_debug_file "gpr_1749_test.ml";
 #end    
     let lambda_output = compile ~filename output_prefix env sigs lam in
     let (//) = Filename.concat in 

jscomp/test/.depend

@@ -234,6 +234,7 @@ gpr_1701_test.cmj : ../stdlib/list.cmj
 gpr_1716_test.cmj : mt.cmj
 gpr_1717_test.cmj :
 gpr_1728_test.cmj : mt.cmj
+gpr_1749_test.cmj : mt.cmj
 gpr_405_test.cmj : ../stdlib/hashtbl.cmj gpr_405_test.cmi
 gpr_441.cmj :
 gpr_459_test.cmj : mt.cmj

jscomp/test/Makefile

@@ -167,7 +167,8 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	gpr_1716_test\
 	gpr_1728_test\
 	gpr_1409_test\
-	rec_fun_test
+	rec_fun_test\
+	gpr_1749_test
 # bs_uncurry_test
 # needs Lam to get rid of Uncurry arity first
 

jscomp/test/gpr_1749_test.js

@@ -0,0 +1,41 @@
+'use strict';
+
+var Mt    = require("./mt.js");
+var Block = require("../../lib/js/block.js");
+
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+  test_id[0] = test_id[0] + 1 | 0;
+  suites[0] = /* :: */[
+    /* tuple */[
+      loc + (" id " + test_id[0]),
+      (function () {
+          return /* Eq */Block.__(0, [
+                    x,
+                    y
+                  ]);
+        })
+    ],
+    suites[0]
+  ];
+  return /* () */0;
+}
+
+var match = +(1 < 1);
+
+var a = 1 < (
+  match !== 0 ? 1 : 10
+) ? 0 : 1;
+
+eq("File \"gpr_1749_test.ml\", line 18, characters 6-13", 0, a);
+
+Mt.from_pair_suites("gpr_1749_test.ml", suites[0]);
+
+exports.suites  = suites;
+exports.test_id = test_id;
+exports.eq      = eq;
+exports.a       = a;
+/*  Not a pure module */

jscomp/test/gpr_1749_test.ml

@@ -0,0 +1,20 @@
+
+let suites :  Mt.pair_suites ref  = ref []
+let test_id = ref 0
+let eq loc x y = 
+  incr test_id ; 
+  suites := 
+    (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
+
+
+
+let a =
+     if 1. < (match 1. < 1. with | true  -> 1. | false  -> 10.)
+     then 0
+     else 1
+
+
+
+;; eq __LOC__ 0 a
+;; Mt.from_pair_suites __FILE__ !suites     
+

jscomp/test/ocaml_typedtree_test.js

@@ -66496,9 +66496,9 @@ function check_well_founded(env, loc, path, to_check, ty) {
     var ty$1 = repr(ty);
     if (mem$3(ty$1, exp_nodes)) {
       var match = ty0[/* desc */0];
-      var $js$2;
-      $js$2 = typeof match === "number" || match.tag !== 3 ? /* false */0 : same(match[0], path);
-      if ($js$2) {
+      var $js;
+      $js = typeof match === "number" || match.tag !== 3 ? /* false */0 : same(match[0], path);
+      if ($js) {
         throw [
               $$Error$8,
               loc,
@@ -66565,6 +66565,20 @@ function check_well_founded(env, loc, path, to_check, ty) {
       catch (raw_exn){
         var exn$1 = Js_exn.internalToOCamlException(raw_exn);
         if (exn$1 === Cannot_expand) {
+          var match$3 = ty$1[/* desc */0];
+          var $js$1;
+          if (typeof match$3 === "number") {
+            $js$1 = /* false */0;
+          } else {
+            switch (match$3.tag | 0) {
+              case 4 : 
+              case 8 : 
+                  $js$1 = /* true */1;
+                  break;
+              default:
+                $js$1 = /* false */0;
+            }
+          }
           var nodes = recursive_types[0] && is_contractive(env, ty$1) || $js$1 ? /* Empty */0 : exp_nodes$1;
           return iter_type_expr((function (param) {
                         return check(ty0, nodes, param);