fix && || tail call, it generates some large expressions (Fix #50)

jscomp/js_output.ml

@@ -48,7 +48,9 @@ let of_block ?value ?(finished = False) block =
 
 let dummy = {value = None; block = []; finished = Dummy }
 
-let handle_name_tail (name : st) (should_return : Lam_compile_defs.return_type)
+let handle_name_tail 
+    (name : st)
+    (should_return : Lam_compile_defs.return_type)
     lam (exp : J.expression) : t =
   begin match name, should_return with 
   | EffectCall, False -> 
@@ -66,10 +68,13 @@ let handle_name_tail (name : st) (should_return : Lam_compile_defs.return_type)
   | NeedValue, _ -> {block = []; value = Some exp; finished = False }
   end
 
-let handle_block_return (st : st) (should_return : Lam_compile_defs.return_type) (lam : Lambda.lambda) (block : J.block) exp : t = 
+let handle_block_return 
+    (st : st) 
+    (should_return : Lam_compile_defs.return_type)
+    (lam : Lambda.lambda) (block : J.block) exp : t = 
   match st, should_return with 
   | Declare (kind,n), False -> 
-      make (block @ [ S.define ~kind  n exp])
+    make (block @ [ S.define ~kind  n exp])
   | Assign n, False -> make (block @ [S.assign n exp])
   | (Declare _ | Assign _), True _ -> make [S.unknown_lambda lam] ~finished:True
   | EffectCall, False -> make block ~value:exp

jscomp/lam_analysis.ml

@@ -454,3 +454,4 @@ let is_closed_by set lam =
 
 let is_closed  lam = 
   Ident_map.is_empty (free_variables Ident_set.empty Ident_map.empty lam)  
+

jscomp/lam_analysis.mli

@@ -61,3 +61,5 @@ val free_variables : Ident_set.t -> stats Ident_map.t -> Lambda.lambda -> stats
 
 val small_inline_size : int 
 val exit_inline_size : int 
+
+

jscomp/lam_compile.ml

@@ -453,6 +453,53 @@ and
         *)
         | {value =  None; _} -> assert false 
       end
+    | Lprim(Psequand , [l;r] )
+      ->
+      begin match cxt with 
+        | {should_return = True _ } 
+          (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
+          ->
+          compile_lambda cxt (Lifthenelse (l, r, Lam_util.lam_false))
+        | _ -> 
+          let l_block,l_expr = 
+            match compile_lambda {cxt with st = NeedValue; should_return = False} l with 
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false 
+          in
+          let r_block, r_expr = 
+            match compile_lambda {cxt with st = NeedValue; should_return = False} r with
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false 
+          in
+          let args_code =  l_block @ r_block  in
+          let exp =  E.and_ l_expr r_expr  in
+          Js_output.handle_block_return st should_return lam args_code exp           
+      end
+
+    | Lprim(Psequor, [l;r])
+      ->
+      begin match cxt with
+        | {should_return = True _ }
+          (* Invariant: if [should_return], then [st] will not be [NeedValue] *)
+          ->
+          compile_lambda cxt (Lifthenelse (l, Lam_util.lam_true, r))
+        | _ ->
+          let l_block,l_expr =
+            match compile_lambda {cxt with st = NeedValue; should_return = False} l with
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false
+          in
+          let r_block, r_expr =
+            match compile_lambda {cxt with st = NeedValue; should_return = False} r with
+            | {block = a; value = Some b} -> a, b
+            | _ -> assert false
+          in
+          let args_code =  l_block @ r_block  in
+          let exp =  E.or_ l_expr r_expr  in
+          Js_output.handle_block_return st should_return lam args_code exp
+      end
+
+
     | Lprim (prim, args_lambda)  ->
       begin
         let args_block, args_expr =

jscomp/lam_util.ml

@@ -311,3 +311,8 @@ let print_ident_set fmt s =
 
 let mk_apply_info ?(loc = Location.none)  apply_status : Lambda.apply_info =
   { apply_loc = loc; apply_status }
+
+
+let lam_true : Lambda.lambda = Lconst (Const_pointer ( 1, NullConstructor "true")) 
+
+let lam_false : Lambda.lambda = Lconst (Const_pointer( 0, NullConstructor "false"))

jscomp/lam_util.mli

@@ -58,3 +58,6 @@ val ident_set_of_list : Ident.t list -> Ident_set.t
 val print_ident_set : Format.formatter -> Ident_set.t -> unit
 
 val mk_apply_info : ?loc:Location.t -> Lambda.apply_status -> Lambda.apply_info
+
+val lam_true : Lambda.lambda
+val lam_false : Lambda.lambda

jscomp/runtime/caml_string.js

@@ -149,7 +149,12 @@ function caml_string_of_char_array(chars) {
 
 function caml_is_printable(c) {
   var code = c;
-  return +(code > 31 && code < 127);
+  if (code > 31) {
+    return +(code < 127);
+  }
+  else {
+    return /* false */0;
+  }
 }
 
 exports.add                       = add;

jscomp/stdlib/camlinternalFormat.js

@@ -339,7 +339,12 @@ function bprint_char_set(buf, char_set) {
     var is_alone = function (c) {
       var match_001 = Char.chr(c - 1);
       var match_002 = Char.chr(c + 1);
-      return +(is_in_char_set(set, c) && !(is_in_char_set(set, match_001) && is_in_char_set(set, match_002)));
+      if (is_in_char_set(set, c)) {
+        return !(is_in_char_set(set, match_001) && is_in_char_set(set, match_002));
+      }
+      else {
+        return /* false */0;
+      }
     };
     if (is_alone(/* "]" */93)) {
       buffer_add_char(buf, /* "]" */93);

jscomp/stdlib/filename.js

@@ -98,15 +98,35 @@ function is_dir_sep(s, i) {
 }
 
 function is_relative(n) {
-  return +(n.length < 1 || n.charCodeAt(0) !== /* "/" */47);
+  if (n.length < 1) {
+    return /* true */1;
+  }
+  else {
+    return +(n.charCodeAt(0) !== /* "/" */47);
+  }
 }
 
 function is_implicit(n) {
-  return +(is_relative(n) && (n.length < 2 || $$String.sub(n, 0, 2) !== "./") && (n.length < 3 || $$String.sub(n, 0, 3) !== "../"));
+  if (is_relative(n) && (n.length < 2 || $$String.sub(n, 0, 2) !== "./")) {
+    if (n.length < 3) {
+      return /* true */1;
+    }
+    else {
+      return +($$String.sub(n, 0, 3) !== "../");
+    }
+  }
+  else {
+    return /* false */0;
+  }
 }
 
 function check_suffix(name, suff) {
-  return +(name.length >= suff.length && $$String.sub(name, name.length - suff.length, suff.length) === suff);
+  if (name.length >= suff.length) {
+    return +($$String.sub(name, name.length - suff.length, suff.length) === suff);
+  }
+  else {
+    return /* false */0;
+  }
 }
 
 var temp_dir_name;

jscomp/stdlib/hashtbl.js

@@ -361,15 +361,21 @@ function replace(h, key, info) {
 }
 
 function mem(h, key) {
-  var mem_in_bucket = function (param) {
+  var _param = h[2][key_index(h, key)];
+  while(true) {
+    var param = _param;
     if (param) {
-      return +(Caml_primitive.caml_compare(param[1], key) === 0 || mem_in_bucket(param[3]));
+      if (Caml_primitive.caml_compare(param[1], key)) {
+        _param = param[3];
+      }
+      else {
+        return /* true */1;
+      }
     }
     else {
       return /* false */0;
     }
   };
-  return mem_in_bucket(h[2][key_index(h, key)]);
 }
 
 function iter(f, h) {
@@ -620,15 +626,21 @@ function MakeSeeded(H) {
     }
   };
   var mem = function (h, key) {
-    var mem_in_bucket = function (param) {
+    var _param = h[2][key_index(h, key)];
+    while(true) {
+      var param = _param;
       if (param) {
-        return +(H[1](param[1], key) || mem_in_bucket(param[3]));
+        if (H[1](param[1], key)) {
+          return /* true */1;
+        }
+        else {
+          _param = param[3];
+        }
       }
       else {
         return /* false */0;
       }
     };
-    return mem_in_bucket(h[2][key_index(h, key)]);
   };
   return [
           0,
@@ -823,15 +835,21 @@ function Make(H) {
     }
   };
   var mem = function (h, key) {
-    var mem_in_bucket = function (param) {
+    var _param = h[2][key_index(h, key)];
+    while(true) {
+      var param = _param;
       if (param) {
-        return +(equal(param[1], key) || mem_in_bucket(param[3]));
+        if (equal(param[1], key)) {
+          return /* true */1;
+        }
+        else {
+          _param = param[3];
+        }
       }
       else {
         return /* false */0;
       }
     };
-    return mem_in_bucket(h[2][key_index(h, key)]);
   };
   var create$1 = function (sz) {
     return create([