Skip to content

Propagate Debugging Identifiers through the Middle End #3967

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 9 commits into
base: main
Choose a base branch
from
Draft

Propagate Debugging Identifiers through the Middle End #3967

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
9a22da8
propagate uids from typed tree through lambda
spiessimon Apr 30, 2025
353da39
uids middle end
spiessimon Apr 30, 2025
c1963bc
rename flambda_uid -> flambda_debug_uid
spiessimon Apr 30, 2025
ce32e64
rename debug uid constructors
spiessimon Apr 30, 2025
a7df026
cleanup backend_var and debug_uid
spiessimon Apr 30, 2025
3d81059
more name cleanup
spiessimon Apr 30, 2025
00bebd7
inspect cases where we do not have debug uid's (Part 1)
spiessimon Apr 30, 2025
22e9adf
inspect cases where we do not have debug uid's (Part 2)
spiessimon May 5, 2025
88bc6df
update comments for Name_mode.in_types
spiessimon May 5, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 6 additions & 4 deletions bytecomp/bytegen.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -875,8 +875,9 @@ and comp_expr stack_info env exp sz cont =
Stack.push to_compile functions_to_compile;
comp_args stack_info env (List.map (fun n -> Lvar n) fv) sz
(Kclosure(lbl, List.length fv) :: cont)
| Llet(_, _k, id, arg, body)
| Lmutlet(_k, id, arg, body) ->
| Llet(_, _k, id, _duid, arg, body)
| Lmutlet(_k, id, _duid, arg, body) ->
(* We are intentionally dropping the [debug_uid] identifiers here. *)
comp_expr stack_info env arg sz
(Kpush :: comp_expr stack_info (add_var id (sz+1) env) body (sz+1)
(add_pop 1 cont))
Expand Down Expand Up @@ -1158,7 +1159,7 @@ and comp_expr stack_info env exp sz cont =
comp_args stack_info env args sz
(comp_primitive stack_info p (sz + nargs - 1) args :: cont)
| Lstaticcatch (body, (i, vars) , handler, _, _) ->
let vars = List.map fst vars in
let vars = List.map fst3 vars in
let nvars = List.length vars in
let branch1, cont1 = make_branch cont in
let r =
Expand Down Expand Up @@ -1202,7 +1203,8 @@ and comp_expr stack_info env exp sz cont =
comp_expr stack_info env arg sz cont
| _ -> comp_exit_args stack_info env args sz size cont
end
| Ltrywith(body, id, handler, _kind) ->
| Ltrywith(body, id, _duid, handler, _kind) ->
(* We are intentionally dropping the [debug_uid] identifiers here. *)
let (branch1, cont1) = make_branch cont in
let lbl_handler = new_label() in
let body_cont =
Expand Down
2 changes: 2 additions & 0 deletions chamelon/compat.jst.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -146,6 +146,7 @@ let mkTexp_function ?(id = texp_function_defaults)
| Some default ->
Tparam_optional_default (pattern, default, id.param_sort));
fp_param = param;
fp_param_debug_uid = Lambda.debug_uid_none;
fp_partial = partial;
fp_sort = id.param_sort;
fp_mode = id.param_mode;
Expand All @@ -163,6 +164,7 @@ let mkTexp_function ?(id = texp_function_defaults)
{
fc_cases = cases;
fc_param = param;
fc_param_debug_uid = Lambda.debug_uid_none;
fc_partial = partial;
fc_env = id.env;
fc_ret_type = id.ret_type;
Expand Down
130 changes: 72 additions & 58 deletions lambda/lambda.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -802,8 +802,12 @@ type parameter_attribute = {
unbox_param: bool;
}

type debug_uid = Shape.Uid.t
let debug_uid_none = Shape.Uid.internal_not_actually_unique

type lparam = {
name : Ident.t;
debug_uid : debug_uid;
layout : layout;
attributes : parameter_attribute;
mode : locality_mode
Expand All @@ -819,18 +823,18 @@ type lambda =
| Lconst of structured_constant
| Lapply of lambda_apply
| Lfunction of lfunction
| Llet of let_kind * layout * Ident.t * lambda * lambda
| Lmutlet of layout * Ident.t * lambda * lambda
| Llet of let_kind * layout * Ident.t * debug_uid * lambda * lambda
| Lmutlet of layout * Ident.t * debug_uid * lambda * lambda
| Lletrec of rec_binding list * lambda
| Lprim of primitive * lambda list * scoped_location
| Lswitch of lambda * lambda_switch * scoped_location * layout
| Lstringswitch of
lambda * (string * lambda) list * lambda option * scoped_location * layout
| Lstaticraise of static_label * lambda list
| Lstaticcatch of
lambda * (static_label * (Ident.t * layout) list) * lambda
lambda * (static_label * (Ident.t * debug_uid * layout) list) * lambda
* pop_region * layout
| Ltrywith of lambda * Ident.t * lambda * layout
| Ltrywith of lambda * Ident.t * debug_uid * lambda * layout
| Lifthenelse of lambda * lambda * lambda * layout
| Lsequence of lambda * lambda
| Lwhile of lambda_while
Expand All @@ -846,6 +850,7 @@ type lambda =

and rec_binding = {
id : Ident.t;
debug_uid : debug_uid;
def : lfunction;
}

Expand All @@ -867,6 +872,7 @@ and lambda_while =

and lambda_for =
{ for_id : Ident.t;
for_debug_uid : debug_uid;
for_loc : scoped_location;
for_from : lambda;
for_to : lambda;
Expand Down Expand Up @@ -1092,20 +1098,20 @@ let make_key e =
Lapply {ap with ap_func = tr_rec env ap.ap_func;
ap_args = tr_recs env ap.ap_args;
ap_loc = Loc_unknown}
| Llet (Alias,_k,x,ex,e) -> (* Ignore aliases -> substitute *)
| Llet (Alias,_k,x,_x_duid,ex,e) -> (* Ignore aliases -> substitute *)
let ex = tr_rec env ex in
tr_rec (Ident.add x ex env) e
| Llet ((Strict | StrictOpt),_k,x,ex,Lvar v) when Ident.same v x ->
| Llet ((Strict | StrictOpt),_k,x,_x_duid,ex,Lvar v) when Ident.same v x ->
tr_rec env ex
| Llet (str,k,x,ex,e) ->
| Llet (str,k,x,x_duid,ex,e) ->
(* Because of side effects, keep other lets with normalized names *)
let ex = tr_rec env ex in
let y = make_key x in
Llet (str,k,y,ex,tr_rec (Ident.add x (Lvar y) env) e)
| Lmutlet (k,x,ex,e) ->
Llet (str,k,y,x_duid,ex,tr_rec (Ident.add x (Lvar y) env) e)
| Lmutlet (k,x,x_duid,ex,e) ->
let ex = tr_rec env ex in
let y = make_key x in
Lmutlet (k,y,ex,tr_rec (Ident.add x (Lmutvar y) env) e)
Lmutlet (k,y,x_duid,ex,tr_rec (Ident.add x (Lmutvar y) env) e)
| Lprim (p,es,_) ->
Lprim (p,tr_recs env es, Loc_unknown)
| Lswitch (e,sw,loc,kind) ->
Expand All @@ -1120,8 +1126,8 @@ let make_key e =
Lstaticraise (i,tr_recs env es)
| Lstaticcatch (e1,xs,e2, r, kind) ->
Lstaticcatch (tr_rec env e1,xs,tr_rec env e2, r, kind)
| Ltrywith (e1,x,e2,kind) ->
Ltrywith (tr_rec env e1,x,tr_rec env e2,kind)
| Ltrywith (e1,x,x_duid,e2,kind) ->
Ltrywith (tr_rec env e1,x,x_duid,tr_rec env e2,kind)
| Lifthenelse (cond,ifso,ifnot,kind) ->
Lifthenelse (tr_rec env cond,tr_rec env ifso,tr_rec env ifnot,kind)
| Lsequence (e1,e2) ->
Expand Down Expand Up @@ -1163,7 +1169,8 @@ let name_lambda strict arg layout fn =
Lvar id -> fn id
| _ ->
let id = Ident.create_local "let" in
Llet(strict, layout, id, arg, fn id)
let id_debug_uid = debug_uid_none in
Llet(strict, layout, id, id_debug_uid, arg, fn id)

let name_lambda_list args fn =
let rec name_list names = function
Expand All @@ -1172,7 +1179,8 @@ let name_lambda_list args fn =
name_list (arg :: names) rem
| (arg, layout) :: rem ->
let id = Ident.create_local "let" in
Llet(Strict, layout, id, arg, name_list (Lvar id :: names) rem) in
let id_debug_uid = debug_uid_none in
Llet(Strict, layout, id, id_debug_uid, arg, name_list (Lvar id :: names) rem) in
name_list [] args


Expand All @@ -1188,8 +1196,8 @@ let shallow_iter ~tail ~non_tail:f = function
f fn; List.iter f args
| Lfunction{body} ->
f body
| Llet(_, _k, _id, arg, body)
| Lmutlet(_k, _id, arg, body) ->
| Llet(_, _k, _id, _duid, arg, body)
| Lmutlet(_k, _id, _duid, arg, body) ->
f arg; tail body
| Lletrec(decl, body) ->
tail body;
Expand All @@ -1213,7 +1221,7 @@ let shallow_iter ~tail ~non_tail:f = function
List.iter f args
| Lstaticcatch(e1, _, e2, _, _kind) ->
tail e1; tail e2
| Ltrywith(e1, _, e2,_) ->
| Ltrywith(e1, _, _, e2,_) ->
f e1; tail e2
| Lifthenelse(e1, e2, e3,_) ->
f e1; tail e2; tail e3
Expand Down Expand Up @@ -1248,8 +1256,8 @@ let rec free_variables = function
| Lfunction{body; params} ->
Ident.Set.diff (free_variables body)
(Ident.Set.of_list (List.map (fun p -> p.name) params))
| Llet(_, _k, id, arg, body)
| Lmutlet(_k, id, arg, body) ->
| Llet(_, _k, id, _duid, arg, body)
| Lmutlet(_k, id, _duid, arg, body) ->
Ident.Set.union
(free_variables arg)
(Ident.Set.remove id (free_variables body))
Expand Down Expand Up @@ -1288,9 +1296,9 @@ let rec free_variables = function
Ident.Set.union
(Ident.Set.diff
(free_variables handler)
(Ident.Set.of_list (List.map fst params)))
(Ident.Set.of_list (List.map fst3 params)))
(free_variables body)
| Ltrywith(body, param, handler, _) ->
| Ltrywith(body, param, _duid, handler, _) ->
Ident.Set.union
(Ident.Set.remove
param
Expand Down Expand Up @@ -1340,15 +1348,15 @@ let staticfail = Lstaticraise (0,[])

let rec is_guarded = function
| Lifthenelse(_cond, _body, Lstaticraise (0,[]),_) -> true
| Llet(_str, _k, _id, _lam, body) -> is_guarded body
| Llet(_str, _k, _id, _duid, _lam, body) -> is_guarded body
| Levent(lam, _ev) -> is_guarded lam
| _ -> false

let rec patch_guarded patch = function
| Lifthenelse (cond, body, Lstaticraise (0,[]), kind) ->
Lifthenelse (cond, body, patch, kind)
| Llet(str, k, id, lam, body) ->
Llet (str, k, id, lam, patch_guarded patch body)
| Llet(str, k, id, duid, lam, body) ->
Llet (str, k, id, duid, lam, patch_guarded patch body)
| Levent(lam, ev) ->
Levent (patch_guarded patch lam, ev)
| _ -> fatal_error "Lambda.patch_guarded"
Expand Down Expand Up @@ -1445,26 +1453,29 @@ let build_substs update_env ?(freshen_bound_variables = false) s =
[l] with all the bound variables of the input term in the current
scope, mapped to either themselves or freshened versions of
themselves when [freshen_bound_variables] is set. *)
let bind id l =
let bind id duid l =
let id' = if not freshen_bound_variables then id else Ident.rename id in
id', Ident.Map.add id id' l
(* CR sspies: If [freshen_bound_variables] is set, this code duplicates
the debug uids. [freshen_bound_variables] is currently only set by
[duplicate] below, which is called from [tmc.ml]. *)
id', duid, Ident.Map.add id id' l
in
let bind_many ids l =
List.fold_right (fun (id, rhs) (ids', l) ->
let id', l = bind id l in
((id', rhs) :: ids' , l)
List.fold_right (fun (id, duid, rhs) (ids', l) ->
let id', duid', l = bind id duid l in
((id', duid', rhs) :: ids' , l)
) ids ([], l)
in
let bind_params params l =
List.fold_right (fun p (params', l) ->
let name', l = bind p.name l in
({ p with name = name' } :: params' , l)
List.fold_right (fun (p: lparam) (params', l) ->
let name', duid', l = bind p.name p.debug_uid l in
({ p with name = name'; debug_uid = duid' } :: params' , l)
) params ([], l)
in
let bind_rec ids l =
List.fold_right (fun rb (ids', l) ->
let id', l = bind rb.id l in
({ rb with id = id' } :: ids' , l)
List.fold_right (fun (rb: rec_binding) (ids', l) ->
let id', duid', l = bind rb.id rb.debug_uid l in
({ rb with id = id'; debug_uid = duid' } :: ids' , l)
) ids ([], l)
in
let rec subst s l lam =
Expand Down Expand Up @@ -1492,12 +1503,12 @@ let build_substs update_env ?(freshen_bound_variables = false) s =
ap_args = subst_list s l ap.ap_args}
| Lfunction lf ->
Lfunction (subst_lfun s l lf)
| Llet(str, k, id, arg, body) ->
let id, l' = bind id l in
Llet(str, k, id, subst s l arg, subst s l' body)
| Lmutlet(k, id, arg, body) ->
let id, l' = bind id l in
Lmutlet(k, id, subst s l arg, subst s l' body)
| Llet(str, k, id, duid, arg, body) ->
let id, duid, l' = bind id duid l in
Llet(str, k, id, duid, subst s l arg, subst s l' body)
| Lmutlet(k, id, duid, arg, body) ->
let id, duid, l' = bind id duid l in
Lmutlet(k, id, duid, subst s l arg, subst s l' body)
| Lletrec(decl, body) ->
let decl, l' = bind_rec decl l in
Lletrec(List.map (subst_decl s l') decl, subst s l' body)
Expand All @@ -1519,17 +1530,18 @@ let build_substs update_env ?(freshen_bound_variables = false) s =
let params, l' = bind_many params l in
Lstaticcatch(subst s l body, (id, params),
subst s l' handler, r, kind)
| Ltrywith(body, exn, handler,kind) ->
let exn, l' = bind exn l in
Ltrywith(subst s l body, exn, subst s l' handler,kind)
| Ltrywith(body, exn, duid, handler,kind) ->
let exn, duid, l' = bind exn duid l in
Ltrywith(subst s l body, exn, duid, subst s l' handler,kind)
| Lifthenelse(e1, e2, e3,kind) ->
Lifthenelse(subst s l e1, subst s l e2, subst s l e3,kind)
| Lsequence(e1, e2) -> Lsequence(subst s l e1, subst s l e2)
| Lwhile lw -> Lwhile { wh_cond = subst s l lw.wh_cond;
wh_body = subst s l lw.wh_body}
| Lfor lf ->
let for_id, l' = bind lf.for_id l in
let for_id, for_duid, l' = bind lf.for_id lf.for_debug_uid l in
Lfor {lf with for_id;
for_debug_uid = for_duid;
for_from = subst s l lf.for_from;
for_to = subst s l lf.for_to;
for_body = subst s l' lf.for_body}
Expand Down Expand Up @@ -1640,10 +1652,10 @@ let shallow_map ~tail ~non_tail:f = function
}
| Lfunction lfun ->
Lfunction (map_lfunction f lfun)
| Llet (str, layout, v, e1, e2) ->
Llet (str, layout, v, f e1, tail e2)
| Lmutlet (layout, v, e1, e2) ->
Lmutlet (layout, v, f e1, tail e2)
| Llet (str, layout, v, v_duid, e1, e2) ->
Llet (str, layout, v, v_duid, f e1, tail e2)
| Lmutlet (layout, v, v_duid, e1, e2) ->
Lmutlet (layout, v, v_duid, f e1, tail e2)
| Lletrec (idel, e2) ->
Lletrec
(List.map (fun rb ->
Expand Down Expand Up @@ -1674,8 +1686,8 @@ let shallow_map ~tail ~non_tail:f = function
Lstaticraise (i, List.map f args)
| Lstaticcatch (body, id, handler, r, layout) ->
Lstaticcatch (tail body, id, tail handler, r, layout)
| Ltrywith (e1, v, e2, layout) ->
Ltrywith (f e1, v, tail e2, layout)
| Ltrywith (e1, v, duid, e2, layout) ->
Ltrywith (f e1, v, duid, tail e2, layout)
| Lifthenelse (e1, e2, e3, layout) ->
Lifthenelse (f e1, tail e2, tail e3, layout)
| Lsequence (e1, e2) ->
Expand Down Expand Up @@ -1706,10 +1718,12 @@ let map f =

(* To let-bind expressions to variables *)

let bind_with_layout str (var, layout) exp body =
let bind_with_layout str (var, duid, layout) exp body =
match exp with
Lvar var' when Ident.same var var' -> body
| _ -> Llet(str, layout, var, exp, body)
(* CR sspies: This implicitly assumes that they have the same debug uid,
which is probably correct.*)
| _ -> Llet(str, layout, var, duid, exp, body)

let negate_integer_comparison = function
| Ceq -> Cne
Expand Down Expand Up @@ -2421,7 +2435,7 @@ let compute_expr_layout free_vars_kind lam =
| Lfunction _ -> layout_function
| Lapply { ap_result_layout; _ } -> ap_result_layout
| Lsend (_, _, _, _, _, _, _, layout) -> layout
| Llet(_, kind, id, _, body) | Lmutlet(kind, id, _, body) ->
| Llet(_, kind, id, _duid, _, body) | Lmutlet(kind, id, _duid, _, body) ->
compute_expr_layout (Ident.Map.add id kind kinds) body
| Lletrec(defs, body) ->
let kinds =
Expand All @@ -2432,7 +2446,7 @@ let compute_expr_layout free_vars_kind lam =
| Lprim(p, _, _) ->
primitive_result_layout p
| Lswitch(_, _, _, kind) | Lstringswitch(_, _, _, _, kind)
| Lstaticcatch(_, _, _, _, kind) | Ltrywith(_, _, _, kind)
| Lstaticcatch(_, _, _, _, kind) | Ltrywith(_, _, _, _, kind)
| Lifthenelse(_, _, _, kind) | Lregion (_, kind) ->
kind
| Lstaticraise (_, _) ->
Expand Down Expand Up @@ -2555,8 +2569,8 @@ let rec try_to_find_location lam =
| Lsend (_, _, _, _, _, _, loc, _)
| Levent (_, { lev_loc = loc; _ }) ->
loc
| Llet (_, _, _, lam, _)
| Lmutlet (_, _, lam, _)
| Llet (_, _, _, _, lam, _)
| Lmutlet (_, _, _, lam, _)
| Lifthenelse (lam, _, _, _)
| Lstaticcatch (lam, _, _, _, _)
| Lstaticraise (_, lam :: _)
Expand All @@ -2566,7 +2580,7 @@ let rec try_to_find_location lam =
| Lifused (_, lam)
| Lregion (lam, _)
| Lexclave lam
| Ltrywith (lam, _, _, _) ->
| Ltrywith (lam, _, _, _, _) ->
try_to_find_location lam
| Lvar _ | Lmutvar _ | Lconst _ | Lletrec _ | Lstaticraise (_, []) ->
Debuginfo.Scoped_location.Loc_unknown
Expand Down
Loading
Loading