Merge pull request rescript-lang#3711 from BuckleScript/code_gen_no_inline_self_recur

[code gen] not inlining self recursive functions

Author: bobzhang

jscomp/core/lam_analysis.ml

@@ -377,7 +377,10 @@ let destruct_pattern (body : Lam.t) params args =
  | _ -> false
 
 (** Hints to inlining *)
-let ok_to_inline_fun_when_app ~body params args =
+let ok_to_inline_fun_when_app 
+ ~(body : Lam.t) 
+ (params : Ident.t list)
+ (args : Lam.t list) =
  let s = size body in
  s < small_inline_size ||
  (destruct_pattern body params args) || 

jscomp/core/lam_coercion.ml

@@ -144,7 +144,7 @@ let handle_exports (meta : Lam_stats.t)
  (FunctionId{arity ; lambda = 
  match lam with 
  | Lfunction _ -> 
- Some (lam, Non_rec)
+ Some (lam, Lam_non_rec)
  | _ -> None })
  );
  { acc with

jscomp/core/lam_id_kind.ml

@@ -28,8 +28,13 @@
 
 
 type rec_flag = 
- | Rec 
- | Non_rec
+ | Lam_rec 
+ | Lam_non_rec
+ | Lam_self_rec 
+ (* only a 
+ single mutual 
+ recursive function 
+ *)
 
 
 type function_id = {

jscomp/core/lam_id_kind.mli

@@ -24,12 +24,14 @@
 
 
 type rec_flag = 
- | Rec 
- | Non_rec
+ | Lam_rec 
+ | Lam_non_rec
 
 (* TODO: This may contain some closure environment,
  check how it will interact with dead code elimination
 *) 
+ | Lam_self_rec
+ (* not inlining in this case *)
 type function_id = {
  mutable arity : Lam_arity.t;
  lambda : (Lam.t * rec_flag) option ;

jscomp/core/lam_pass_collect.ml

@@ -143,9 +143,13 @@ let collect_helper (meta : Lam_stats.t) (lam : Lam.t) =
  List.iter (fun p -> Ident_hashtbl.add meta.ident_tbl p Parameter ) params;
  collect l
  | Llet (kind,ident,arg,body) -> 
- collect_bind Non_rec kind ident arg ; collect body
+ collect_bind Lam_non_rec kind ident arg ; collect body
  | Lletrec (bindings, body) -> 
- List.iter (fun (ident,arg) -> collect_bind Rec Strict ident arg ) bindings;
+ (match bindings with 
+ | [ident, arg] -> collect_bind Lam_self_rec Strict ident arg
+ | _ -> 
+ Ext_list.iter bindings
+ (fun (ident,arg) -> collect_bind Lam_rec Strict ident arg )) ;
  collect body
  | Lglobal_module _ -> ()
  | Lprim {args; _} -> List.iter collect args

jscomp/core/lam_pass_remove_alias.ml

@@ -234,10 +234,14 @@ let simplify_alias
  match is_export_id, param_map with 
  | false, (_, param_map)
  | true, (true, param_map) -> 
- if rec_flag = Rec then 
- Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args
- else 
- simpl (Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args)
+ begin match rec_flag with 
+ 
+ | Lam_rec -> Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args
+ | Lam_self_rec -> normal ()
+ | Lam_non_rec -> 
+ simpl 
+ (Lam_beta_reduce.propogate_beta_reduce_with_map meta param_map params body args)
+ end
  | _ -> normal ()
  else 
  normal ()

jscomp/test/build.ninja

@@ -302,6 +302,7 @@ build test/gpr_3566_drive_test.cmi test/gpr_3566_drive_test.cmj : cc test/gpr_35
 build test/gpr_3566_test.cmi test/gpr_3566_test.cmj : cc test/gpr_3566_test.ml | $stdlib
 build test/gpr_3595_test.cmi test/gpr_3595_test.cmj : cc test/gpr_3595_test.ml | test/mt.cmj $stdlib
 build test/gpr_3609_test.cmi test/gpr_3609_test.cmj : cc test/gpr_3609_test.ml | $stdlib
+build test/gpr_3697_test.cmi test/gpr_3697_test.cmj : cc test/gpr_3697_test.ml | $stdlib
 build test/gpr_373_test.cmi test/gpr_373_test.cmj : cc test/gpr_373_test.ml | $stdlib
 build test/gpr_405_test.cmj : cc_cmi test/gpr_405_test.ml | test/gpr_405_test.cmi $stdlib
 build test/gpr_405_test.cmi : cc test/gpr_405_test.mli | $stdlib

jscomp/test/gpr_3697_test.js

@@ -0,0 +1,39 @@
+'use strict';
+
+var Block = require("../../lib/js/block.js");
+var CamlinternalLazy = require("../../lib/js/camlinternalLazy.js");
+
+function fix(param) {
+ return /* Fix */[Block.__(246, [(function (param) {
+ return fix(/* () */0);
+ })])];
+}
+
+function unfixLeak(_param) {
+ while(true) {
+ var param = _param;
+ var f = param[0];
+ var tag = f.tag | 0;
+ _param = tag === 250 ? f[0] : (
+ tag === 246 ? CamlinternalLazy.force_lazy_block(f) : f
+ );
+ continue ;
+ };
+}
+
+function unfix(p) {
+ while(true) {
+ var match = p[0];
+ var match$1 = match[0];
+ var tag = match$1.tag | 0;
+ p[0] = tag === 250 ? match$1[0] : (
+ tag === 246 ? CamlinternalLazy.force_lazy_block(match$1) : match$1
+ );
+ };
+ return /* () */0;
+}
+
+exports.fix = fix;
+exports.unfixLeak = unfixLeak;
+exports.unfix = unfix;
+/* No side effect */

jscomp/test/gpr_3697_test.ml

@@ -0,0 +1,16 @@
+type 'a t = Fix of 'a t lazy_t
+
+let rec fix () = Fix (lazy (fix ()))
+
+
+let rec unfixLeak (Fix f) =
+ unfixLeak @@ Lazy.force f
+
+
+let unfix p = 
+ while true do 
+ p := match !p with (Fix lazy h) -> h
+ done 
+(* ;; unfixLeak (fix ()) *)
+
+(* ;; unfix (ref (fix ())) *)

jscomp/test/rec_value_test.js

@@ -465,16 +465,14 @@ function fake_inline_minus(n) {
  return n + 1 | 0;
 }
 
-function fake_inline(n) {
- return n + 1 | 0;
-}
+var fake_inline = fake_inline_minus;
+
+var fake_inline_inlie2 = fake_inline_minus(3);
 
 Mt.from_pair_suites("Rec_value_test", suites);
 
 var v$1 = 3;
 
-var fake_inline_inlie2 = 4;
-
 exports.x = x;
 exports.a = a;
 exports.b = b;