Skip to content

Commit 9d90a93

Browse files
mshinwelllthls
andauthored
Fix breaking of tail recursion in classic mode (#1915)
Co-authored-by: Vincent Laviron <[email protected]>
1 parent 4abdad8 commit 9d90a93

File tree

2 files changed

+41
-0
lines changed

2 files changed

+41
-0
lines changed

middle_end/flambda2/from_lambda/lambda_to_flambda.ml

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -885,6 +885,12 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
885885
[new_id, value_kind]
886886
User_visible (Simple new_value) ~body)
887887
k_exn
888+
| Llet ((Strict | Alias | StrictOpt), _layout, id, defining_expr, Lvar id')
889+
when Ident.same id id' ->
890+
(* Simplif already simplifies such bindings, but we can generate new ones
891+
when translating primitives (see the Lprim case below). *)
892+
(* This case must not be moved above the case for let-bound primitives. *)
893+
cps acc env ccenv defining_expr k k_exn
888894
| Llet ((Strict | Alias | StrictOpt), layout, id, defining_expr, body) ->
889895
let_cont_nonrecursive_with_extra_params acc env ccenv ~is_exn_handler:false
890896
~params:[id, is_user_visible env id, layout]
@@ -936,6 +942,12 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
936942
Misc.fatal_errorf "Wrong number of arguments for Lraise: %a"
937943
Printlambda.primitive prim)
938944
| _ ->
945+
(* The code for translating primitives needs a let binding, so we
946+
introduce such a binding explicitly. *)
947+
(* For primitives like [Psequand], which are transformed instead, this
948+
binding is useless and can move calls out of tail position, so we rely
949+
on a special case above that removes such bindings when the bound
950+
expression isn't a primitive. *)
939951
let name = Printlambda.name_of_primitive prim in
940952
let id = Ident.create_local name in
941953
let result_layout = L.primitive_result_layout prim in
Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
(* TEST *)
2+
3+
(* Test that the right-hand sides of && and || are in tail position *)
4+
5+
let limit = 1000000
6+
7+
let rec f1 i x =
8+
if i > limit then x else x && f1 (i + 1) x
9+
10+
let rec f2 i x y z =
11+
if i > limit then x else x && y && z && f2 (i + 1) x y z
12+
13+
let rec f3 i x =
14+
if i > limit then x else x || f3 (i + 1) x
15+
16+
let rec f4 i x y z =
17+
if i > limit then x else x || y || z || f4 (i + 1) x y z
18+
19+
let () =
20+
ignore (Sys.opaque_identity (f1 0 true))
21+
22+
let () =
23+
ignore (Sys.opaque_identity (f2 0 true true true))
24+
25+
let () =
26+
ignore (Sys.opaque_identity (f3 0 false))
27+
28+
let () =
29+
ignore (Sys.opaque_identity (f4 0 false false false))

0 commit comments

Comments
 (0)