--- a/src/ppx/instrument.ml 2022-10-31 16:01:28.486756629 -0600 +++ b/src/ppx/instrument.ml 2022-10-31 17:05:13.572237694 -0600 @@ -1039,24 +1039,24 @@ class instrumenter = let instrument_cases = Generated_code.instrument_cases points in object (self) - inherit Ppxlib.Ast_traverse.map_with_expansion_context as super + inherit Ppxlib.Ast_traverse.map_with_expansion_context_and_errors as super method! class_expr ctxt ce = let loc = ce.pcl_loc in let attrs = ce.pcl_attributes in - let ce = super#class_expr ctxt ce in + let ce, locs = super#class_expr ctxt ce in match ce.pcl_desc with | Pcl_fun (l, e, p, ce) -> - Cl.fun_ ~loc ~attrs l (Option.map instrument_expr e) p ce + Cl.fun_ ~loc ~attrs l (Option.map instrument_expr e) p ce, locs | _ -> - ce + ce, locs method! class_field ctxt cf = let loc = cf.pcf_loc in let attrs = cf.pcf_attributes in - let cf = super#class_field ctxt cf in + let cf, locs = super#class_field ctxt cf in match cf.pcf_desc with | Pcf_method (name, private_, cf) -> @@ -1065,13 +1065,13 @@ class instrumenter = (match cf with | Cfk_virtual _ -> cf | Cfk_concrete (o, e) -> - Cf.concrete o (instrument_expr e)) + Cf.concrete o (instrument_expr e)), locs | Pcf_initializer e -> - Cf.initializer_ ~loc ~attrs (instrument_expr e) + Cf.initializer_ ~loc ~attrs (instrument_expr e), locs | _ -> - cf + cf, locs method! expression ctxt e = let is_trivial_function = Parsetree.(function @@ -1494,17 +1494,19 @@ class instrumenter = (f, traverse ~is_in_tail_position:false e))) | Pexp_letmodule (m, e, e') -> + let mexpr', _locs = (self#module_expr ctxt e) in Exp.letmodule ~loc ~attrs m - (self#module_expr ctxt e) + mexpr' (traverse ~is_in_tail_position e') | Pexp_letexception (c, e) -> Exp.letexception ~loc ~attrs c (traverse ~is_in_tail_position e) | Pexp_open (m, e) -> + let oexpr', _locs = (self#open_declaration ctxt m) in Exp.open_ ~loc ~attrs - (self#open_declaration ctxt m) + oexpr' (traverse ~is_in_tail_position e) | Pexp_newtype (t, e) -> @@ -1513,10 +1515,12 @@ class instrumenter = (* Expressions that don't need instrumentation, and where AST traversal leaves the expression language. *) | Pexp_object c -> - Exp.object_ ~loc ~attrs (self#class_structure ctxt c) + let cstr, _locs = (self#class_structure ctxt c) in + Exp.object_ ~loc ~attrs cstr | Pexp_pack m -> - Exp.pack ~loc ~attrs (self#module_expr ctxt m) + let mexpr', _locs = (self#module_expr ctxt m) in + Exp.pack ~loc ~attrs mexpr' (* Expressions that are not recursively traversed at all. *) | Pexp_extension _ | Pexp_unreachable -> @@ -1536,7 +1540,7 @@ class instrumenter = in - traverse ~is_in_tail_position:false e + traverse ~is_in_tail_position:false e, [] (* Set to [true] upon encountering [[@@@coverage.off]], and back to [false] again upon encountering [[@@@coverage.on]]. *) @@ -1548,7 +1552,7 @@ class instrumenter = match si.pstr_desc with | Pstr_value (rec_flag, bindings) -> if structure_instrumentation_suppressed then - si + si, [] else let bindings = @@ -1580,16 +1584,18 @@ class instrumenter = if do_not_instrument then binding else - {binding with pvb_expr = self#expression ctxt binding.pvb_expr} + let expr', _errs = self#expression ctxt binding.pvb_expr in + {binding with pvb_expr = expr'} end in - Str.value ~loc rec_flag bindings + Str.value ~loc rec_flag bindings, [] | Pstr_eval (e, a) -> if structure_instrumentation_suppressed then - si + si, [] else - Str.eval ~loc ~attrs:a (self#expression ctxt e) + let expr', errors = self#expression ctxt e in + Str.eval ~loc ~attrs:a expr', errors | Pstr_attribute attribute -> let kind = Coverage_attributes.recognize attribute in @@ -1612,17 +1618,17 @@ class instrumenter = Location.raise_errorf ~loc:attribute.attr_loc "coverage exclude_file is not allowed here." end; - si + si, [] | _ -> super#structure_item ctxt si (* Don't instrument payloads of extensions and attributes. *) method! extension _ e = - e + e, [] method! attribute _ a = - a + a, [] method! structure ctxt ast = let saved_structure_instrumentation_suppressed = @@ -1655,7 +1661,7 @@ class instrumenter = ast else begin - let instrumented_ast = super#structure ctxt ast in + let instrumented_ast, _errs = super#structure ctxt ast in let runtime_initialization = Generated_code.runtime_initialization points path in runtime_initialization @ instrumented_ast --- a/src/ppx/instrument.mli 2022-03-14 01:39:55.000000000 -0600 +++ b/src/ppx/instrument.mli 2022-10-31 15:48:11.733614835 -0600 @@ -5,7 +5,7 @@ class instrumenter : object - inherit Ppxlib.Ast_traverse.map_with_expansion_context + inherit Ppxlib.Ast_traverse.map_with_expansion_context_and_errors method transform_impl_file: Ppxlib.Expansion_context.Base.t ->