tentative fix for #2608

Author: bobzhang

jscomp/core/bs_conditional_initial.ml

@@ -25,7 +25,7 @@
 
 let setup_env () = 
 #if BS_DEBUG then    
-    Js_config.set_debug_file "test_bool_equal.ml";
+    Js_config.set_debug_file "gpr_2608_test.ml";
 #end       
   Lexer.replace_directive_bool "BS" true;
   Lexer.replace_directive_string "BS_VERSION"  Bs_version.version

jscomp/core/lam_compile.ml

@@ -676,26 +676,37 @@ and
           (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
           ->
           compile_lambda cxt (Lam.sequand  l r )
-        | _ -> 
-
+        | {should_return = ReturnFalse } -> 
+          let new_cxt = {cxt with st = NeedValue} in
           match
-            compile_lambda 
-              {cxt with st = NeedValue; should_return = ReturnFalse} l with 
+            compile_lambda new_cxt l with 
           | { value = None } -> assert false   
           | {block = l_block; value = Some l_expr} ->
-            match
-              compile_lambda
-                {cxt with st = NeedValue; should_return = ReturnFalse} r
+            match compile_lambda new_cxt r
             with
             | { value = None } -> assert false 
-            | {block = r_block; value = Some r_expr} -> 
-              let args_code =  Ext_list.append l_block  r_block  in
-              let exp =  E.and_ l_expr r_expr  in
+            | {block = []; value = Some r_expr} 
+              ->               
               Js_output.output_of_block_and_expression 
                 st 
-                should_return lam args_code exp           
+                should_return lam l_block (E.and_ l_expr r_expr)
+            | { block = r_block; value = Some r_expr} ->    
+              let v = Ext_ident.create_tmp () in 
+              Js_output.output_of_block_and_expression
+              st 
+              should_return 
+              lam
+              (S.define_variable ~kind:Variable v E.caml_false :: 
+                l_block @
+                [S.if_ l_expr                  
+                  (r_block @ [
+                    S.assign v r_expr
+                  ]
+                  )
+                ]
+              )
+              (E.var v)
       end
-
     | Lprim {primitive = Psequor; args =  [l;r]}
       ->
       begin match cxt with
@@ -1184,7 +1195,9 @@ and
              when branches are minimial (less than 2)
           *)
           let v = Ext_ident.create_tmp () in
-          Js_output.make (S.declare_variable ~kind:Variable v   :: compile_whole {cxt with st = Assign v})
+          Js_output.make 
+            (S.declare_variable ~kind:Variable v   :: 
+              compile_whole {cxt with st = Assign v})
             ~value:(E.var  v)
 
         | Declare (kind,id) -> 

jscomp/test/.depend

@@ -304,6 +304,7 @@ gpr_2316_test.cmj : mt.cmj ../runtime/js.cmj
 gpr_2474.cmj :
 gpr_2487.cmj : ../others/belt.cmj
 gpr_2503_test.cmj : mt.cmj ../runtime/js.cmj
+gpr_2608_test.cmj : mt.cmj ../stdlib/list.cmj
 gpr_405_test.cmj : ../stdlib/hashtbl.cmj gpr_405_test.cmi
 gpr_441.cmj :
 gpr_459_test.cmj : mt.cmj

jscomp/test/Makefile

@@ -241,6 +241,7 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_
 	gpr_2487\
 	gpr_2503_test\
 	block_alias_test\
+	gpr_2608_test\
 # bs_uncurry_test
 # needs Lam to get rid of Uncurry arity first
 # simple_derive_test

jscomp/test/ext_string_test.js

@@ -59,15 +59,23 @@ function trim(s) {
   var i = 0;
   var j = s.length;
   while((function () {
-          var u = s.charCodeAt(i);
-          return +(i < j && (u === /* "\t" */9 || u === /* "\n" */10 || u === /* " " */32));
+          var tmp = /* false */0;
+          if (i < j) {
+            var u = s.charCodeAt(i);
+            tmp = +(u === /* "\t" */9 || u === /* "\n" */10 || u === /* " " */32);
+          }
+          return tmp;
         })()) {
     i = i + 1 | 0;
   };
   var k = j - 1 | 0;
   while((function () {
-          var u = s.charCodeAt(k);
-          return +(k >= i && (u === /* "\t" */9 || u === /* "\n" */10 || u === /* " " */32));
+          var tmp = /* false */0;
+          if (k >= i) {
+            var u = s.charCodeAt(k);
+            tmp = +(u === /* "\t" */9 || u === /* "\n" */10 || u === /* " " */32);
+          }
+          return tmp;
         })()) {
     k = k - 1 | 0;
   };

jscomp/test/gpr_2608_test.js

@@ -0,0 +1,42 @@
+'use strict';
+
+var Mt = require("./mt.js");
+var List = require("../../lib/js/list.js");
+
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+  return Mt.eq_suites(test_id, suites, loc, x, y);
+}
+
+var oppHeroes = /* :: */[
+  0,
+  /* [] */0
+];
+
+var tmp = /* false */0;
+
+if (List.length(/* [] */0) > 0) {
+  var x = List.filter((function () {
+            return +(List.hd(/* [] */0) <= 1000);
+          }))(oppHeroes);
+  tmp = +(List.length(x) === 0);
+}
+
+var huntGrootCondition = tmp;
+
+eq("File \"gpr_2608_test.ml\", line 17, characters 5-12", huntGrootCondition, /* false */0);
+
+Mt.from_pair_suites("gpr_2608_test.ml", suites[0]);
+
+var nearestGroots = /* [] */0;
+
+exports.suites = suites;
+exports.test_id = test_id;
+exports.eq = eq;
+exports.nearestGroots = nearestGroots;
+exports.oppHeroes = oppHeroes;
+exports.huntGrootCondition = huntGrootCondition;
+/* huntGrootCondition Not a pure module */

jscomp/test/gpr_2608_test.ml

@@ -0,0 +1,19 @@
+
+let suites :  Mt.pair_suites ref  = ref []
+let test_id = ref 0
+let eq loc x y = Mt.eq_suites ~test_id ~suites loc x y 
+
+
+let nearestGroots = []
+
+let oppHeroes = [0]
+let huntGrootCondition =
+  List.length nearestGroots > 0 &&
+     let x = (List.filter (fun h  -> (List.hd nearestGroots) <= 1000) 
+        oppHeroes) in 
+        List.length x = 0
+
+let () = 
+  eq __LOC__ huntGrootCondition false
+let () =         
+  Mt.from_pair_suites __FILE__ !suites