Skip to content

Commit 90c6746

Browse files
gretay-jsstedolan
andauthored
flambda-backend: Improve code-generation for inlined comparisons (port upstream PR#10228) (#563)
* Improve code-generation for inlined comparisons (#10228) Compile `if (let x = E in COND) then IFSO else IFNOT` like `let x = E in if COND then IFSO else IFNOT`. Co-authored-by: Stephen Dolan <[email protected]>
1 parent da6ff04 commit 90c6746

File tree

1 file changed

+9
-6
lines changed

1 file changed

+9
-6
lines changed

asmcomp/cmmgen.ml

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -443,7 +443,7 @@ let rec transl env e =
443443
let args = List.map (transl env) args in
444444
send kind met obj args pos dbg
445445
| Ulet(str, kind, id, exp, body) ->
446-
transl_let env str kind id exp body
446+
transl_let env str kind id exp (fun env -> transl env body)
447447
| Uphantom_let (var, defining_expr, body) ->
448448
let defining_expr =
449449
match defining_expr with
@@ -1155,7 +1155,7 @@ and transl_unbox_sized size dbg env exp =
11551155
| Thirty_two -> transl_unbox_int dbg env Pint32 exp
11561156
| Sixty_four -> transl_unbox_int dbg env Pint64 exp
11571157

1158-
and transl_let env str kind id exp body =
1158+
and transl_let env str kind id exp transl_body =
11591159
let dbg = Debuginfo.none in
11601160
let cexp = transl env exp in
11611161
let unboxing =
@@ -1192,16 +1192,16 @@ and transl_let env str kind id exp body =
11921192
(* N.B. [body] must still be traversed even if [exp] will never return:
11931193
there may be constant closures inside that need lifting out. *)
11941194
begin match str, kind with
1195-
| (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl env body)
1196-
| Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl env body)
1197-
| Mutable, _ -> Clet_mut(id, typ_val, cexp, transl env body)
1195+
| (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl_body env)
1196+
| Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl_body env)
1197+
| Mutable, _ -> Clet_mut(id, typ_val, cexp, transl_body env)
11981198
end
11991199
| Boxed (boxed_number, false) ->
12001200
let unboxed_id = V.create_local (VP.name id) in
12011201
let v = VP.create unboxed_id in
12021202
let cexp = unbox_number dbg boxed_number cexp in
12031203
let body =
1204-
transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in
1204+
transl_body (add_unboxed_id (VP.var id) unboxed_id boxed_number env) in
12051205
begin match str, boxed_number with
12061206
| (Immutable | Immutable_unique), _ -> Clet (v, cexp, body)
12071207
| Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body)
@@ -1243,6 +1243,9 @@ and transl_if env (approx : then_else)
12431243
ifso_dbg arg2
12441244
then_dbg then_
12451245
else_dbg else_
1246+
| Ulet(str, kind, id, exp, cond) ->
1247+
transl_let env str kind id exp (fun env ->
1248+
transl_if env approx dbg cond then_dbg then_ else_dbg else_)
12461249
| Uprim (Psequand, [arg1; arg2], inner_dbg) ->
12471250
transl_sequand env approx
12481251
inner_dbg arg1

0 commit comments

Comments
 (0)