diff --git a/Changes b/Changes
index 79890eba64cd..58f8e3ca643c 100644
--- a/Changes
+++ b/Changes
@@ -207,6 +207,9 @@ Working version
 - GPR#1739: ensure ocamltest waits for child processes to terminate on Windows.
   (David Allsopp, review by Sébastien Hinderer)
 
+- MPR#7554, GPR#1751: Lambda.subst: also update debug event environments
+  (Thomas Refis, review by Gabriel Scherer)
+
 - MPR#7238, GPR#1825: in Unix.in_channel_of_descr and Unix.out_channel_of_descr,
   raise an error if the given file description is not suitable for
   character-oriented I/O, for example if it is a block device or a
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index a282185082e3..d0d46de8576f 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -843,7 +843,7 @@ let rec comp_expr env exp sz cont =
           ev_loc = lev.lev_loc;
           ev_kind = kind;
           ev_info = info;
-          ev_typenv = lev.lev_env;
+          ev_typenv = Env.summary lev.lev_env;
           ev_typsubst = Subst.identity;
           ev_compenv = env;
           ev_stacksize = sz;
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index bc5589adf01e..e9c476249b7d 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -314,7 +314,7 @@ and lambda_event =
   { lev_loc: Location.t;
     lev_kind: lambda_event_kind;
     lev_repr: int ref option;
-    lev_env: Env.summary }
+    lev_env: Env.t }
 
 and lambda_event_kind =
     Lev_before
@@ -641,66 +641,84 @@ let rec make_sequence fn = function
    Assumes that the image of the substitution is out of reach
    of the bound variables of the lambda-term (no capture). *)
 
-let rec subst s lam =
-  let remove_list l s =
-    List.fold_left (fun s id -> Ident.Map.remove id s) s l
+let subst update_env s lam =
+  let rec subst s lam =
+    let remove_list l s =
+      List.fold_left (fun s id -> Ident.Map.remove id s) s l
+    in
+    let module M = Ident.Map in
+    match lam with
+    | Lvar id as l ->
+        begin try Ident.Map.find id s with Not_found -> l end
+    | Lconst _ as l -> l
+    | Lapply ap ->
+        Lapply{ap with ap_func = subst s ap.ap_func;
+                      ap_args = subst_list s ap.ap_args}
+    | Lfunction{kind; params; body; attr; loc} ->
+        let s = List.fold_right Ident.Map.remove params s in
+        Lfunction{kind; params; body = subst s body; attr; loc}
+    | Llet(str, k, id, arg, body) ->
+        Llet(str, k, id, subst s arg, subst (Ident.Map.remove id s) body)
+    | Lletrec(decl, body) ->
+        let s =
+          List.fold_left (fun s (id, _) -> Ident.Map.remove id s)
+            s decl
+        in
+        Lletrec(List.map (subst_decl s) decl, subst s body)
+    | Lprim(p, args, loc) -> Lprim(p, subst_list s args, loc)
+    | Lswitch(arg, sw, loc) ->
+        Lswitch(subst s arg,
+                {sw with sw_consts = List.map (subst_case s) sw.sw_consts;
+                        sw_blocks = List.map (subst_case s) sw.sw_blocks;
+                        sw_failaction = subst_opt s sw.sw_failaction; },
+                loc)
+    | Lstringswitch (arg,cases,default,loc) ->
+        Lstringswitch
+          (subst s arg,List.map (subst_strcase s) cases,subst_opt s default,loc)
+    | Lstaticraise (i,args) ->  Lstaticraise (i, subst_list s args)
+    | Lstaticcatch(body, (id, params), handler) ->
+        Lstaticcatch(subst s body, (id, params),
+                    subst (remove_list params s) handler)
+    | Ltrywith(body, exn, handler) ->
+        Ltrywith(subst s body, exn, subst (Ident.Map.remove exn s) handler)
+    | Lifthenelse(e1, e2, e3) -> Lifthenelse(subst s e1, subst s e2, subst s e3)
+    | Lsequence(e1, e2) -> Lsequence(subst s e1, subst s e2)
+    | Lwhile(e1, e2) -> Lwhile(subst s e1, subst s e2)
+    | Lfor(v, lo, hi, dir, body) ->
+        Lfor(v, subst s lo, subst s hi, dir,
+          subst (Ident.Map.remove v s) body)
+    | Lassign(id, e) ->
+        assert(not (Ident.Map.mem id s));
+        Lassign(id, subst s e)
+    | Lsend (k, met, obj, args, loc) ->
+        Lsend (k, subst s met, subst s obj, subst_list s args, loc)
+    | Levent (lam, evt) ->
+        let lev_env =
+          Ident.Map.fold (fun id _ env ->
+            match Env.find_value (Path.Pident id) evt.lev_env with
+            | exception Not_found -> env
+            | vd -> update_env id vd env
+          ) s evt.lev_env
+        in
+        Levent (subst s lam, { evt with lev_env })
+    | Lifused (v, e) -> Lifused (v, subst s e)
+  and subst_list s l = List.map (subst s) l
+  and subst_decl s (id, exp) = (id, subst s exp)
+  and subst_case s (key, case) = (key, subst s case)
+  and subst_strcase s (key, case) = (key, subst s case)
+  and subst_opt s = function
+    | None -> None
+    | Some e -> Some (subst s e)
   in
-  let module M = Ident.Map in
-  match lam with
-  | Lvar id as l ->
-      begin try Ident.Map.find id s with Not_found -> l end
-  | Lconst _ as l -> l
-  | Lapply ap ->
-      Lapply{ap with ap_func = subst s ap.ap_func;
-                     ap_args = subst_list s ap.ap_args}
-  | Lfunction{kind; params; body; attr; loc} ->
-      let s = List.fold_right Ident.Map.remove params s in
-      Lfunction{kind; params; body = subst s body; attr; loc}
-  | Llet(str, k, id, arg, body) ->
-      Llet(str, k, id, subst s arg, subst (Ident.Map.remove id s) body)
-  | Lletrec(decl, body) ->
-      let s =
-        List.fold_left (fun s (id, _) -> Ident.Map.remove id s)
-          s decl
-      in
-      Lletrec(List.map (subst_decl s) decl, subst s body)
-  | Lprim(p, args, loc) -> Lprim(p, subst_list s args, loc)
-  | Lswitch(arg, sw, loc) ->
-      Lswitch(subst s arg,
-              {sw with sw_consts = List.map (subst_case s) sw.sw_consts;
-                       sw_blocks = List.map (subst_case s) sw.sw_blocks;
-                       sw_failaction = subst_opt s sw.sw_failaction; },
-              loc)
-  | Lstringswitch (arg,cases,default,loc) ->
-      Lstringswitch
-        (subst s arg,List.map (subst_strcase s) cases,subst_opt s default,loc)
-  | Lstaticraise (i,args) ->  Lstaticraise (i, subst_list s args)
-  | Lstaticcatch(body, (id, params), handler) ->
-      Lstaticcatch(subst s body, (id, params),
-                   subst (remove_list params s) handler)
-  | Ltrywith(body, exn, handler) ->
-      Ltrywith(subst s body, exn, subst (Ident.Map.remove exn s) handler)
-  | Lifthenelse(e1, e2, e3) -> Lifthenelse(subst s e1, subst s e2, subst s e3)
-  | Lsequence(e1, e2) -> Lsequence(subst s e1, subst s e2)
-  | Lwhile(e1, e2) -> Lwhile(subst s e1, subst s e2)
-  | Lfor(v, lo, hi, dir, body) ->
-      Lfor(v, subst s lo, subst s hi, dir,
-        subst (Ident.Map.remove v s) body)
-  | Lassign(id, e) ->
-      assert(not (Ident.Map.mem id s));
-      Lassign(id, subst s e)
-  | Lsend (k, met, obj, args, loc) ->
-      Lsend (k, subst s met, subst s obj, subst_list s args, loc)
-  | Levent (lam, evt) -> Levent (subst s lam, evt)
-  | Lifused (v, e) -> Lifused (v, subst s e)
-and subst_list s l = List.map (subst s) l
-and subst_decl s (id, exp) = (id, subst s exp)
-and subst_case s (key, case) = (key, subst s case)
-and subst_strcase s (key, case) = (key, subst s case)
-and subst_opt s = function
-  | None -> None
-  | Some e -> Some (subst s e)
+  subst s lam
 
+let rename idmap lam =
+  let update_env oldid vd env =
+    let newid = Ident.Map.find oldid idmap in
+    Env.add_value newid vd env
+  in
+  let s = Ident.Map.map (fun new_id -> Lvar new_id) idmap in
+  subst update_env s lam
 
 let rec map f lam =
   let lam =
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 2e64854dd046..20019b97ab97 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -296,7 +296,7 @@ and lambda_event =
   { lev_loc: Location.t;
     lev_kind: lambda_event_kind;
     lev_repr: int ref option;
-    lev_env: Env.summary }
+    lev_env: Env.t }
 
 and lambda_event_kind =
     Lev_before
@@ -349,10 +349,20 @@ val transl_class_path: ?loc:Location.t -> Env.t -> Path.t -> lambda
 
 val make_sequence: ('a -> lambda) -> 'a list -> lambda
 
-val subst: lambda Ident.Map.t -> lambda -> lambda
-(** Apply a substitution to a lambda-term.
+val subst: (Ident.t -> Types.value_description -> Env.t -> Env.t) ->
+  lambda Ident.Map.t -> lambda -> lambda
+(** [subst env_update_fun s lt] applies a substitution [s] to the lambda-term
+    [lt].
+
     Assumes that the image of the substitution is out of reach
-    of the bound variables of the lambda-term (no capture). *)
+    of the bound variables of the lambda-term (no capture).
+
+    [env_update_fun] is used to refresh the environment contained in debug
+    events.  *)
+
+val rename : Ident.t Ident.Map.t -> lambda -> lambda
+(** A version of [subst] specialized for the case where we're just renaming
+    idents. *)
 
 val map : (lambda -> lambda) -> lambda -> lambda
 val bind : let_kind -> Ident.t -> lambda -> lambda -> lambda
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml
index ea9513f94072..93a2b3e085f6 100644
--- a/bytecomp/simplif.ml
+++ b/bytecomp/simplif.ml
@@ -264,13 +264,10 @@ let simplify_exits lam =
       begin try
         let xs,handler =  Hashtbl.find subst i in
         let ys = List.map Ident.rename xs in
-        let env =
-          List.fold_right2
-            (fun x y t -> Ident.Map.add x (Lvar y) t)
-            xs ys Ident.Map.empty in
+        let env = List.fold_right2 Ident.Map.add xs ys Ident.Map.empty in
         List.fold_right2
           (fun y l r -> Llet (Alias, Pgenval, y, l, r))
-          ys ls (Lambda.subst env handler)
+          ys ls (Lambda.rename env handler)
       with
       | Not_found -> Lstaticraise (i,ls)
       end
@@ -680,12 +677,12 @@ let split_default_wrapper ~id:fun_id ~kind ~params ~body ~attr ~loc =
         in
         let inner_params = List.map map_param params in
         let new_ids = List.map Ident.rename inner_params in
-        let subst = List.fold_left2
-            (fun s id new_id ->
-               Ident.Map.add id (Lvar new_id) s)
-            Ident.Map.empty inner_params new_ids
+        let subst =
+          List.fold_left2 (fun s id new_id ->
+            Ident.Map.add id new_id s
+          ) Ident.Map.empty inner_params new_ids
         in
-        let body = Lambda.subst subst body in
+        let body = Lambda.rename subst body in
         let inner_fun =
           Lfunction { kind = Curried; params = new_ids; body; attr; loc; }
         in
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index 79a3425ddd1e..f53c7160c581 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -690,12 +690,13 @@ let transl_class ids cl_id pub_meths cl vflag =
       Ident.Map.empty !new_ids'
   in
   let new_ids_meths = ref [] in
+  let no_env_update _ _ env = env in
   let msubst arr = function
       Lfunction {kind = Curried; params = self :: args; body} ->
         let env = Ident.create "env" in
         let body' =
           if new_ids = [] then body else
-          Lambda.subst (subst env body 0 new_ids_meths) body in
+          Lambda.subst no_env_update (subst env body 0 new_ids_meths) body in
         begin try
           (* Doesn't seem to improve size for bytecode *)
           (* if not !Clflags.native_code then raise Not_found; *)
@@ -722,7 +723,7 @@ let transl_class ids cl_id pub_meths cl vflag =
   and subst_env envs l lam =
     if top then lam else
     (* must be called only once! *)
-    let lam = Lambda.subst (subst env1 lam 1 new_ids_init) lam in
+    let lam = Lambda.subst no_env_update (subst env1 lam 1 new_ids_init) lam in
     Llet(Alias, Pgenval, env1, (if l = [] then Lvar envs else lfield envs 0),
     Llet(Alias, Pgenval, env1',
          (if !new_ids_init = [] then Lvar env1 else lfield env1 0),
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 5f4f811f3315..a8f7332f91b9 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -156,7 +156,7 @@ let event_function exp lam =
      Levent(body, {lev_loc = exp.exp_loc;
                    lev_kind = Lev_function;
                    lev_repr = repr;
-                   lev_env = Env.summary exp.exp_env}))
+                   lev_env = exp.exp_env}))
   else
     lam None
 
@@ -456,7 +456,7 @@ and transl_exp0 e =
           lev_loc = loc.loc;
           lev_kind = Lev_module_definition id;
           lev_repr = None;
-          lev_env = Env.summary Env.empty;
+          lev_env = Env.empty;
         })
       in
       Llet(Strict, Pgenval, id, defining_expr, transl_exp body)
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index c4a33edbaeeb..f64382f01290 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -115,16 +115,16 @@ and wrap_id_pos_list loc id_pos_list get_field lam =
   Ident.Set.iter (fun id -> Format.eprintf "%a " Ident.print id) fv;
   Format.eprintf "@.";*)
   let (lam,s) =
-    List.fold_left (fun (lam,s) (id',pos,c) ->
+    List.fold_left (fun (lam, s) (id',pos,c) ->
       if Ident.Set.mem id' fv then
         let id'' = Ident.create (Ident.name id') in
         (Llet(Alias, Pgenval, id'',
-              apply_coercion loc Alias c (get_field pos),lam),
-         Ident.Map.add id' (Lvar id'') s)
-      else (lam,s))
+             apply_coercion loc Alias c (get_field pos),lam),
+         Ident.Map.add id' id'' s)
+      else (lam, s))
       (lam, Ident.Map.empty) id_pos_list
   in
-  if s == Ident.Map.empty then lam else Lambda.subst s lam
+  if s == Ident.Map.empty then lam else Lambda.rename s lam
 
 
 (* Compose two coercions
@@ -520,7 +520,7 @@ and transl_structure loc fields cc rootpath final_env = function
                 {lev_loc = loc;
                  lev_kind = Lev_pseudo;
                  lev_repr = None;
-                 lev_env = Env.summary final_env})
+                 lev_env = final_env})
        else
          body),
       size
@@ -582,7 +582,7 @@ and transl_structure loc fields cc rootpath final_env = function
               lev_loc = mb.mb_loc;
               lev_kind = Lev_module_definition id;
               lev_repr = None;
-              lev_env = Env.summary Env.empty;
+              lev_env = Env.empty;
             })
           in
           Llet(pure_module mb.mb_expr, Pgenval, id,
@@ -605,7 +605,7 @@ and transl_structure loc fields cc rootpath final_env = function
                    lev_loc = loc;
                    lev_kind = Lev_module_definition id;
                    lev_repr = None;
-                   lev_env = Env.summary Env.empty;
+                   lev_env = Env.empty;
                  }))
               bindings
               body
@@ -843,6 +843,7 @@ let field_of_str loc str =
 
 
 let transl_store_structure glob map prims str =
+  let no_env_update _ _ env = env in
   let rec transl_store rootpath subst = function
     [] ->
       transl_store_subst := subst;
@@ -850,14 +851,14 @@ let transl_store_structure glob map prims str =
     | item :: rem ->
         match item.str_desc with
         | Tstr_eval (expr, _attrs) ->
-            Lsequence(Lambda.subst subst (transl_exp expr),
+            Lsequence(Lambda.subst no_env_update subst (transl_exp expr),
                       transl_store rootpath subst rem)
         | Tstr_value(rec_flag, pat_expr_list) ->
             let ids = let_bound_idents pat_expr_list in
             let lam =
               transl_let rec_flag pat_expr_list (store_idents Location.none ids)
             in
-            Lsequence(Lambda.subst subst lam,
+            Lsequence(Lambda.subst no_env_update subst lam,
                       transl_store rootpath (add_idents false ids subst) rem)
         | Tstr_primitive descr ->
             record_primitive descr.val_val;
@@ -872,7 +873,7 @@ let transl_store_structure glob map prims str =
               transl_type_extension item.str_env rootpath tyext
                                     (store_idents Location.none ids)
             in
-            Lsequence(Lambda.subst subst lam,
+            Lsequence(Lambda.subst no_env_update subst lam,
                       transl_store rootpath (add_idents false ids subst) rem)
         | Tstr_exception ext ->
             let id = ext.tyexn_constructor.ext_id in
@@ -882,7 +883,8 @@ let transl_store_structure glob map prims str =
                                            path
                                            ext.tyexn_constructor
             in
-            Lsequence(Llet(Strict, Pgenval, id, Lambda.subst subst lam,
+            Lsequence(Llet(Strict, Pgenval, id,
+                           Lambda.subst no_env_update subst lam,
                            store_ident ext.tyexn_constructor.ext_loc id),
                       transl_store rootpath (add_ident false id subst) rem)
         | Tstr_module{mb_id=id;mb_loc=loc;
@@ -897,7 +899,7 @@ let transl_store_structure glob map prims str =
             let subst = !transl_store_subst in
             Lsequence(lam,
                       Llet(Strict, Pgenval, id,
-                           Lambda.subst subst
+                           Lambda.subst no_env_update subst
                              (Lprim(Pmakeblock(0, Immutable, None),
                                     List.map (fun id -> Lvar id)
                                       (defined_idents str.str_items), loc)),
@@ -925,7 +927,7 @@ let transl_store_structure glob map prims str =
             let field = field_of_str loc str in
             Lsequence(lam,
                       Llet(Strict, Pgenval, id,
-                           Lambda.subst subst
+                           Lambda.subst no_env_update subst
                              (Lprim(Pmakeblock(0, Immutable, None),
                                     List.map field map, loc)),
                            Lsequence(store_ident loc id,
@@ -944,14 +946,14 @@ let transl_store_structure glob map prims str =
                the compilation unit (add_ident true returns subst unchanged).
                If not, we can use the value from the global
                (add_ident true adds id -> Pgetglobal... to subst). *)
-            Llet(Strict, Pgenval, id, Lambda.subst subst lam,
+            Llet(Strict, Pgenval, id, Lambda.subst no_env_update subst lam,
                  Lsequence(store_ident loc id,
                            transl_store rootpath (add_ident true id subst) rem))
         | Tstr_recmodule bindings ->
             let ids = List.map (fun mb -> mb.mb_id) bindings in
             compile_recmodule
               (fun id modl _loc ->
-                 Lambda.subst subst
+                 Lambda.subst no_env_update subst
                    (transl_module Tcoerce_none
                       (field_path rootpath id) modl))
               bindings
@@ -962,7 +964,7 @@ let transl_store_structure glob map prims str =
             let lam =
               Lletrec(class_bindings, store_idents Location.none ids)
             in
-            Lsequence(Lambda.subst subst lam,
+            Lsequence(Lambda.subst no_env_update subst lam,
                       transl_store rootpath (add_idents false ids subst) rem)
 
         | Tstr_include{
@@ -993,7 +995,8 @@ let transl_store_structure glob map prims str =
               | [], [] ->
                   transl_store rootpath (add_idents true ids0 subst) rem
               | id :: ids, arg :: args ->
-                  Llet(Alias, Pgenval, id, Lambda.subst subst (field arg),
+                  Llet(Alias, Pgenval, id,
+                       Lambda.subst no_env_update subst (field arg),
                        Lsequence(store_ident loc id,
                                  loop ids args))
               | _ -> assert false
@@ -1014,7 +1017,8 @@ let transl_store_structure glob map prims str =
                                  store_idents (pos + 1) idl))
             in
             Llet(Strict, Pgenval, mid,
-                 Lambda.subst subst (transl_module Tcoerce_none None modl),
+                 Lambda.subst no_env_update subst
+                   (transl_module Tcoerce_none None modl),
                  store_idents 0 ids)
         | Tstr_modtype _
         | Tstr_open _
@@ -1119,7 +1123,7 @@ let transl_store_gen module_name ({ str_items = str }, restr) topl =
   let f = function
     | [ { str_desc = Tstr_eval (expr, _attrs) } ] when topl ->
         assert (size = 0);
-        Lambda.subst !transl_store_subst (transl_exp expr)
+        Lambda.subst (fun _ _ env -> env) !transl_store_subst (transl_exp expr)
     | str -> transl_store_structure module_id map prims str in
   transl_store_label_init module_id size f str
   (*size, transl_label_init (transl_store_structure module_id map prims str)*)
diff --git a/bytecomp/translprim.ml b/bytecomp/translprim.ml
index 02ce5688672f..60bfa5b58ee6 100644
--- a/bytecomp/translprim.ml
+++ b/bytecomp/translprim.ml
@@ -38,7 +38,7 @@ let event_before exp lam = match lam with
   then Levent(lam, {lev_loc = exp.exp_loc;
                     lev_kind = Lev_before;
                     lev_repr = None;
-                    lev_env = Env.summary exp.exp_env})
+                    lev_env = exp.exp_env})
   else lam
 
 let event_after exp lam =
@@ -46,7 +46,7 @@ let event_after exp lam =
   then Levent(lam, {lev_loc = exp.exp_loc;
                     lev_kind = Lev_after exp.exp_type;
                     lev_repr = None;
-                    lev_env = Env.summary exp.exp_env})
+                    lev_env = exp.exp_env})
   else lam
 
 type comparison =