Improve code-generation for inlined comparisons (port upstream PR#102…

…28) (ocaml#563)

* Improve code-generation for inlined comparisons (ocaml#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 <sdolan@janestreet.com>

backend/cmmgen.ml

@@ -500,7 +500,7 @@ let rec transl env e =
       let args = List.map (transl env) args in
       send kind met obj args pos dbg
   | Ulet(str, kind, id, exp, body) ->
-      transl_let env str kind id exp body
+      transl_let env str kind id exp (fun env -> transl env body)
   | Uphantom_let (var, defining_expr, body) ->
       let defining_expr =
         match defining_expr with
@@ -1218,7 +1218,7 @@ and transl_unbox_sized size dbg env exp =
   | Thirty_two -> transl_unbox_int dbg env Pint32 exp
   | Sixty_four -> transl_unbox_int dbg env Pint64 exp
 
-and transl_let env str (kind : Lambda.value_kind) id exp body =
+and transl_let env str (kind : Lambda.value_kind) id exp transl_body =
   let dbg = Debuginfo.none in
   let cexp = transl env exp in
   let unboxing =
@@ -1243,16 +1243,16 @@ and transl_let env str (kind : Lambda.value_kind) id exp body =
       (* N.B. [body] must still be traversed even if [exp] will never return:
          there may be constant closures inside that need lifting out. *)
       begin match str, kind with
-      | (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl env body)
-      | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl env body)
-      | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl env body)
+      | (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl_body env)
+      | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl_body env)
+      | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl_body env)
       end
   | Boxed (boxed_number, false) ->
       let unboxed_id = V.create_local (VP.name id) in
       let v = VP.create unboxed_id in
       let cexp = unbox_number dbg boxed_number cexp in
       let body =
-        transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in
+        transl_body (add_unboxed_id (VP.var id) unboxed_id boxed_number env) in
       begin match str, boxed_number with
       | (Immutable | Immutable_unique), _ -> Clet (v, cexp, body)
       | Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body)
@@ -1296,6 +1296,9 @@ and transl_if env (kind : Cmm.value_kind) (approx : then_else)
         ifso_dbg arg2
         then_dbg then_
         else_dbg else_
+  | Ulet(str, let_kind, id, exp, cond) ->
+      transl_let env str let_kind id exp (fun env ->
+        transl_if env kind approx dbg cond then_dbg then_ else_dbg else_)
   | Uprim (Psequand, [arg1; arg2], inner_dbg) ->
       transl_sequand env kind approx
         inner_dbg arg1

ocaml/asmcomp/cmmgen.ml

@@ -443,7 +443,7 @@ let rec transl env e =
       let args = List.map (transl env) args in
       send kind met obj args pos dbg
   | Ulet(str, kind, id, exp, body) ->
-      transl_let env str kind id exp body
+      transl_let env str kind id exp (fun env -> transl env body)
   | Uphantom_let (var, defining_expr, body) ->
       let defining_expr =
         match defining_expr with
@@ -1155,7 +1155,7 @@ and transl_unbox_sized size dbg env exp =
   | Thirty_two -> transl_unbox_int dbg env Pint32 exp
   | Sixty_four -> transl_unbox_int dbg env Pint64 exp
 
-and transl_let env str kind id exp body =
+and transl_let env str kind id exp transl_body =
   let dbg = Debuginfo.none in
   let cexp = transl env exp in
   let unboxing =
@@ -1192,16 +1192,16 @@ and transl_let env str kind id exp body =
       (* N.B. [body] must still be traversed even if [exp] will never return:
          there may be constant closures inside that need lifting out. *)
       begin match str, kind with
-      | (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl env body)
-      | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl env body)
-      | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl env body)
+      | (Immutable | Immutable_unique), _ -> Clet(id, cexp, transl_body env)
+      | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl_body env)
+      | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl_body env)
       end
   | Boxed (boxed_number, false) ->
       let unboxed_id = V.create_local (VP.name id) in
       let v = VP.create unboxed_id in
       let cexp = unbox_number dbg boxed_number cexp in
       let body =
-        transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in
+        transl_body (add_unboxed_id (VP.var id) unboxed_id boxed_number env) in
       begin match str, boxed_number with
       | (Immutable | Immutable_unique), _ -> Clet (v, cexp, body)
       | Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body)
@@ -1243,6 +1243,9 @@ and transl_if env (approx : then_else)
         ifso_dbg arg2
         then_dbg then_
         else_dbg else_
+  | Ulet(str, kind, id, exp, cond) ->
+      transl_let env str kind id exp (fun env ->
+        transl_if env approx dbg cond then_dbg then_ else_dbg else_)
   | Uprim (Psequand, [arg1; arg2], inner_dbg) ->
       transl_sequand env approx
         inner_dbg arg1