From cbb72d82caefee89a4708cb3441c9865f2f55ad9 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Fri, 6 Oct 2023 17:39:38 +0100
Subject: [PATCH] flambda-backend: Improve debuginfo for for-loops (and
 conditionals) (#1870)

---
 lambda/lambda.ml                     | 1 +
 lambda/lambda.mli                    | 1 +
 lambda/printlambda.ml                | 2 +-
 lambda/transl_array_comprehension.ml | 2 ++
 lambda/translcore.ml                 | 1 +
 5 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/lambda/lambda.ml b/lambda/lambda.ml
index 5a9598df0f5..aebe1e665ae 100644
--- a/lambda/lambda.ml
+++ b/lambda/lambda.ml
@@ -603,6 +603,7 @@ and lambda_while =
 
 and lambda_for =
   { for_id : Ident.t;
+    for_loc : scoped_location;
     for_from : lambda;
     for_to : lambda;
     for_dir : direction_flag;
diff --git a/lambda/lambda.mli b/lambda/lambda.mli
index 0781462e5aa..f1405eae53e 100644
--- a/lambda/lambda.mli
+++ b/lambda/lambda.mli
@@ -507,6 +507,7 @@ and lambda_while =
 
 and lambda_for =
   { for_id : Ident.t;
+    for_loc : scoped_location;
     for_from : lambda;
     for_to : lambda;
     for_dir : direction_flag;
diff --git a/lambda/printlambda.ml b/lambda/printlambda.ml
index 6d3ac5d431f..611b7881688 100644
--- a/lambda/printlambda.ml
+++ b/lambda/printlambda.ml
@@ -868,7 +868,7 @@ let rec lam ppf = function
   | Lwhile {wh_cond; wh_body} ->
       fprintf ppf "@[<2>(while@ %a@ %a)@]"
         lam wh_cond lam wh_body
-  | Lfor {for_id; for_from; for_to; for_dir; for_body} ->
+  | Lfor {for_id; for_loc = _; for_from; for_to; for_dir; for_body} ->
       fprintf ppf "@[<2>(for %a@ %a@ %s@ %a@ %a)@]"
        Ident.print for_id lam for_from
        (match for_dir with Upto -> "to" | Downto -> "downto")
diff --git a/lambda/transl_array_comprehension.ml b/lambda/transl_array_comprehension.ml
index 661759dcac4..4ef8059277a 100644
--- a/lambda/transl_array_comprehension.ml
+++ b/lambda/transl_array_comprehension.ml
@@ -456,6 +456,7 @@ let iterator ~transl_exp ~scopes ~loc
       let stop  = bound "stop"  stop  in
       let mk_iterator body =
         Lfor { for_id     = ident
+             ; for_loc    = loc
              ; for_from   = start.var
              ; for_to     = stop.var
              ; for_dir    = direction
@@ -483,6 +484,7 @@ let iterator ~transl_exp ~scopes ~loc
         (* for iter_ix = 0 to Array.length iter_arr - 1 ... *)
         (* CR layouts v4: will need updating when we allow non-values in arrays. *)
         Lfor { for_id     = iter_ix
+             ; for_loc    = loc
              ; for_from   = l0
              ; for_to     = iter_len.var - l1
              ; for_dir    = Upto
diff --git a/lambda/translcore.ml b/lambda/translcore.ml
index bdbfcb0a844..4bac06b8f36 100644
--- a/lambda/translcore.ml
+++ b/lambda/translcore.ml
@@ -691,6 +691,7 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
       let body = transl_exp ~scopes for_body_sort for_body in
       Lfor {
         for_id;
+        for_loc = of_location ~scopes e.exp_loc;
         for_from = transl_exp ~scopes Jkind.Sort.for_predef_value for_from;
         for_to = transl_exp ~scopes Jkind.Sort.for_predef_value for_to;
         for_dir;