diff --git a/src/context_free.ml b/src/context_free.ml index ab58b952..efced338 100644 --- a/src/context_free.ml +++ b/src/context_free.ml @@ -518,18 +518,30 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) | None -> self#pexp_apply_without_traversing_function base_ctxt e func args | Some pattern -> ( - match pattern e with + let pat_expr = + try (pattern e, []) + with exn when embed_errors -> (None, [ exn_to_error exn ]) + in + pat_expr >>= fun expr -> + match expr with | None -> self#pexp_apply_without_traversing_function base_ctxt e func args - | Some e -> self#expression base_ctxt e)) + | Some e -> self#expression base_ctxt e + (* with exn when embed_errors -> (e, [ exn_to_error exn ]) *))) | Pexp_ident id -> ( match Hashtbl.find_opt special_functions id.txt with | None -> super#expression base_ctxt e | Some pattern -> ( - match pattern e with + let pat_exp = + try (pattern e, []) + with exn when embed_errors -> (None, [ exn_to_error exn ]) + in + pat_exp >>= fun expr -> + match expr with | None -> super#expression base_ctxt e - | Some e -> self#expression base_ctxt e)) + | Some e -> self#expression base_ctxt e + (* with exn when embed_errors -> (e, [ exn_to_error exn ]) *))) | Pexp_constant (Pconst_integer (s, Some c)) -> ( try expand_constant Integer c s with exn when embed_errors -> (e, [ exn_to_error exn ])) diff --git a/test/driver/exception_handling/run.t b/test/driver/exception_handling/run.t index 3f3d3f3c..3d88c538 100644 --- a/test/driver/exception_handling/run.t +++ b/test/driver/exception_handling/run.t @@ -192,13 +192,14 @@ when the -embed-errors flag is not passed $ echo "n_args2 " >> impl.ml When embed-errors is not passed $ ./special_functions.exe impl.ml - File "_none_", line 1: - Error: error special function + File "impl.ml", lines 1-2, characters 0-7: + Error: error special function [1] When embed-errors is not passed $ ./special_functions.exe -embed-errors impl.ml - [%%ocaml.error "error special function"] + [%%ocaml.error "error special function "] + [%%ocaml.error "second error special function"] ;;n_args n_args2 In the case of whole file transformations: diff --git a/test/driver/exception_handling/special_functions.ml b/test/driver/exception_handling/special_functions.ml index bc45a969..09b24bb5 100644 --- a/test/driver/exception_handling/special_functions.ml +++ b/test/driver/exception_handling/special_functions.ml @@ -1,17 +1,9 @@ open Ppxlib -let expand e = - let return n = Some (Ast_builder.Default.eint ~loc:e.pexp_loc n) in - match e.pexp_desc with - | Pexp_apply (_, _arg_list) -> Location.raise_errorf "error special function" - | _ -> return 0 +let expand e = Location.raise_errorf ~loc:e.pexp_loc "error special function " let expand2 e = - let return n = Some (Ast_builder.Default.eint ~loc:e.pexp_loc n) in - match e.pexp_desc with - | Pexp_apply (_, _arg_list2) -> - Location.raise_errorf "error special function 2" - | _ -> return 0 + Location.raise_errorf ~loc:e.pexp_loc "second error special function" let rule = Context_free.Rule.special_function "n_args" expand let rule2 = Context_free.Rule.special_function "n_args2" expand2;;