From 4b77038fcecf71df9f66f61b65fa3797723c932c Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Fri, 6 Dec 2024 16:27:14 +0100 Subject: [PATCH] TMP: Implement -no-corrections Signed-off-by: Nathan Rebours --- src/context_free.ml | 60 ++++++++++++++++++++++++++++++++++++-------- src/context_free.mli | 1 + src/driver.ml | 43 +++++++++++++++---------------- 3 files changed, 72 insertions(+), 32 deletions(-) diff --git a/src/context_free.ml b/src/context_free.ml index 81f9e310..ab4e4f42 100644 --- a/src/context_free.ml +++ b/src/context_free.ml @@ -462,6 +462,36 @@ let handle_attr_inline attrs ~convert_exn ~item ~expanded_item ~loc ~base_ctxt let error_item = [ convert_exn exn ] in return (error_item :: acc))) +let handle_attr_group_inline_expect attrs rf ~items ~expanded_items ~loc ~base_ctxt + ~embed_errors ~convert_exn ~no_corrections = + if no_corrections then + (* Mark expect attributes as seen *) + List.fold_left attrs ~init:(return ()) + ~f:(fun acc (Rule.Attr_group_inline.T group) -> + acc >>= fun () -> + get_group group.attribute items >>= fun _ -> + get_group group.attribute expanded_items >>= fun _ -> + return ()) + >>= fun () -> return [] + else + handle_attr_group_inline attrs rf ~items ~expanded_items ~loc ~base_ctxt + ~embed_errors ~convert_exn + +let handle_attr_inline_expect attrs ~convert_exn ~item ~expanded_item ~loc ~base_ctxt + ~embed_errors ~no_corrections = + if no_corrections then + (* Mark expect attributes as seen *) + List.fold_left attrs ~init:(return ()) + ~f:(fun acc (Rule.Attr_inline.T a) -> + acc >>= fun () -> + Attribute.get_res a.attribute item |> of_result ~default:None >>= fun _ -> + Attribute.get_res a.attribute expanded_item |> of_result ~default:None >>= fun _ -> + return ()) + >>= fun () -> return [] + else + handle_attr_inline attrs ~item ~expanded_item ~loc ~base_ctxt + ~embed_errors ~convert_exn + module Expect_mismatch_handler = struct type t = { f : 'a. 'a Attribute.Floating.Context.t -> Location.t -> 'a list -> unit; @@ -471,7 +501,9 @@ module Expect_mismatch_handler = struct end class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) - ?(generated_code_hook = Generated_code_hook.nop) ?(embed_errors = false) rules + ?(generated_code_hook = Generated_code_hook.nop) ?(embed_errors = false) + ?(no_corrections = false) + rules = let hook = generated_code_hook in @@ -546,6 +578,12 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) let map_nodes = map_nodes ~hook ~embed_errors in let handle_attr_group_inline = handle_attr_group_inline ~embed_errors in let handle_attr_inline = handle_attr_inline ~embed_errors in + let handle_attr_group_inline_expect = + handle_attr_group_inline_expect ~no_corrections ~embed_errors + in + let handle_attr_inline_expect = + handle_attr_inline_expect ~no_corrections ~embed_errors + in object (self) inherit Ast_traverse.map_with_expansion_context_and_errors as super @@ -780,7 +818,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_group_inline attr_str_type_decls rf ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_group_inline attr_str_type_decls_expect rf + handle_attr_group_inline_expect attr_str_type_decls_expect rf ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> @@ -790,7 +828,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_inline attr_str_module_type_decls ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_inline attr_str_module_type_decls_expect + handle_attr_inline_expect attr_str_module_type_decls_expect ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> @@ -800,7 +838,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_inline attr_str_type_exts ~item:te ~expanded_item:exp_te ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_inline attr_str_type_exts_expect ~item:te + handle_attr_inline_expect attr_str_type_exts_expect ~item:te ~expanded_item:exp_te ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> with_extra_items expanded_item ~extra_items ~expect_items @@ -809,7 +847,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_inline attr_str_exceptions ~item:ec ~expanded_item:exp_ec ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_inline attr_str_exceptions_expect ~item:ec + handle_attr_inline_expect attr_str_exceptions_expect ~item:ec ~expanded_item:exp_ec ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> with_extra_items expanded_item ~extra_items ~expect_items @@ -819,7 +857,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) ~items:cds ~expanded_items:exp_cds ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_group_inline attr_str_class_decls_expect + handle_attr_group_inline_expect attr_str_class_decls_expect Nonrecursive ~items:cds ~expanded_items:exp_cds ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> @@ -889,7 +927,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_group_inline attr_sig_type_decls rf ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_group_inline attr_sig_type_decls_expect rf + handle_attr_group_inline_expect attr_sig_type_decls_expect rf ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> @@ -899,7 +937,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_inline attr_sig_module_type_decls ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_inline attr_sig_module_type_decls_expect + handle_attr_inline_expect attr_sig_module_type_decls_expect ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> @@ -909,7 +947,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_inline attr_sig_type_exts ~item:te ~expanded_item:exp_te ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_inline attr_sig_type_exts_expect ~item:te + handle_attr_inline_expect attr_sig_type_exts_expect ~item:te ~expanded_item:exp_te ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> with_extra_items expanded_item ~extra_items ~expect_items @@ -918,7 +956,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) handle_attr_inline attr_sig_exceptions ~item:ec ~expanded_item:exp_ec ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_inline attr_sig_exceptions_expect ~item:ec + handle_attr_inline_expect attr_sig_exceptions_expect ~item:ec ~expanded_item:exp_ec ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> with_extra_items expanded_item ~extra_items ~expect_items @@ -928,7 +966,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) ~items:cds ~expanded_items:exp_cds ~loc ~base_ctxt ~convert_exn >>= fun extra_items -> - handle_attr_group_inline attr_sig_class_decls_expect + handle_attr_group_inline_expect attr_sig_class_decls_expect Nonrecursive ~items:cds ~expanded_items:exp_cds ~loc ~base_ctxt ~convert_exn >>= fun expect_items -> diff --git a/src/context_free.mli b/src/context_free.mli index c59c0473..e7a09f67 100644 --- a/src/context_free.mli +++ b/src/context_free.mli @@ -166,6 +166,7 @@ class map_top_down : ?generated_code_hook: Generated_code_hook.t (* default: Generated_code_hook.nop *) -> ?embed_errors:bool -> + ?no_corrections:bool -> Rule.t list -> object inherit Ast_traverse.map_with_expansion_context_and_errors diff --git a/src/driver.ml b/src/driver.ml index e515ae24..c60ab04a 100644 --- a/src/driver.ml +++ b/src/driver.ml @@ -219,12 +219,12 @@ module Transform = struct let last = get_loc (last x l) in Some { first with loc_end = last.loc_end } - let merge_into_generic_mappers t ~embed_errors ~hook ~expect_mismatch_handler + let merge_into_generic_mappers t ~no_corrections ~embed_errors ~hook ~expect_mismatch_handler ~tool_name ~input_name = let { rules; enclose_impl; enclose_intf; impl; intf; _ } = t in let map = new Context_free.map_top_down - rules ~embed_errors ~generated_code_hook:hook ~expect_mismatch_handler + rules ~no_corrections ~embed_errors ~generated_code_hook:hook ~expect_mismatch_handler in let gen_header_and_footer context whole_loc f = let header, footer = f whole_loc in @@ -456,7 +456,7 @@ let debug_dropped_attribute name ~old_dropped ~new_dropped = print_diff "disappeared" new_dropped old_dropped; print_diff "reappeared" old_dropped new_dropped -let get_whole_ast_passes ~embed_errors ~hook ~expect_mismatch_handler ~tool_name +let get_whole_ast_passes ~no_corrections ~embed_errors ~hook ~expect_mismatch_handler ~tool_name ~input_name = let cts = match !apply_list with @@ -486,7 +486,7 @@ let get_whole_ast_passes ~embed_errors ~hook ~expect_mismatch_handler ~tool_name if !no_merge then List.map transforms ~f: - (Transform.merge_into_generic_mappers ~embed_errors ~hook ~tool_name + (Transform.merge_into_generic_mappers ~no_corrections ~embed_errors ~hook ~tool_name ~expect_mismatch_handler ~input_name) else (let get_enclosers ~f = @@ -517,7 +517,7 @@ let get_whole_ast_passes ~embed_errors ~hook ~expect_mismatch_handler ~tool_name let footers = List.concat (List.rev footers) in (headers, footers)) in - Transform.builtin_of_context_free_rewriters ~rules ~embed_errors + Transform.builtin_of_context_free_rewriters ~rules ~no_corrections ~embed_errors ~hook ~expect_mismatch_handler ~enclose_impl:(merge_encloser impl_enclosers) ~enclose_intf:(merge_encloser intf_enclosers) @@ -529,9 +529,9 @@ let get_whole_ast_passes ~embed_errors ~hook ~expect_mismatch_handler ~tool_name linters @ preprocess @ before_instrs @ make_generic cts @ after_instrs let apply_transforms ~tool_name ~file_path ~field ~lint_field ~dropped_so_far - ~hook ~expect_mismatch_handler ~input_name ~embed_errors ast = + ~hook ~expect_mismatch_handler ~input_name ~no_corrections ~embed_errors ast = let cts = - get_whole_ast_passes ~tool_name ~embed_errors ~hook ~expect_mismatch_handler + get_whole_ast_passes ~tool_name ~no_corrections ~embed_errors ~hook ~expect_mismatch_handler ~input_name in let finish (ast, _dropped, lint_errors, errors) = @@ -612,10 +612,11 @@ let exn_to_extension exn ~(kind : Kind.t) = let print_passes () = let tool_name = "ppxlib_driver" in let embed_errors = false in + let no_corrections = false in let hook = Context_free.Generated_code_hook.nop in let expect_mismatch_handler = Context_free.Expect_mismatch_handler.nop in let cts = - get_whole_ast_passes ~embed_errors ~hook ~expect_mismatch_handler ~tool_name + get_whole_ast_passes ~no_corrections ~embed_errors ~hook ~expect_mismatch_handler ~tool_name ~input_name:None in if !perform_checks then @@ -635,7 +636,7 @@ let sort_errors_by_loc errors = (*$*) let map_structure_gen st ~tool_name ~hook ~expect_mismatch_handler ~input_name - ~embed_errors = + ~embed_errors ~no_corrections = Cookies.acknowledge_cookies T; if !perform_checks then ( Attribute.reset_checks (); @@ -694,7 +695,7 @@ let map_structure_gen st ~tool_name ~hook ~expect_mismatch_handler ~input_name ~field:(fun (ct : Transform.t) -> ct.impl) ~lint_field:(fun (ct : Transform.t) -> ct.lint_impl) ~dropped_so_far:Attribute.dropped_so_far_structure ~hook - ~expect_mismatch_handler ~input_name ~embed_errors + ~expect_mismatch_handler ~input_name ~embed_errors ~no_corrections in st |> lint lint_errors |> cookies_and_check |> with_errors (List.rev errors) @@ -704,14 +705,14 @@ let map_structure st = ~tool_name:(Astlib.Ast_metadata.tool_name ()) ~hook:Context_free.Generated_code_hook.nop ~expect_mismatch_handler:Context_free.Expect_mismatch_handler.nop - ~input_name:None ~embed_errors:false + ~input_name:None ~embed_errors:false ~no_corrections:false with | ast -> ast (*$ str_to_sig _last_text_block *) let map_signature_gen sg ~tool_name ~hook ~expect_mismatch_handler ~input_name - ~embed_errors = + ~embed_errors ~no_corrections = Cookies.acknowledge_cookies T; if !perform_checks then ( Attribute.reset_checks (); @@ -770,7 +771,7 @@ let map_signature_gen sg ~tool_name ~hook ~expect_mismatch_handler ~input_name ~field:(fun (ct : Transform.t) -> ct.intf) ~lint_field:(fun (ct : Transform.t) -> ct.lint_intf) ~dropped_so_far:Attribute.dropped_so_far_signature ~hook - ~expect_mismatch_handler ~input_name ~embed_errors + ~expect_mismatch_handler ~input_name ~embed_errors ~no_corrections in sg |> lint lint_errors |> cookies_and_check |> with_errors (List.rev errors) @@ -780,7 +781,7 @@ let map_signature sg = ~tool_name:(Astlib.Ast_metadata.tool_name ()) ~hook:Context_free.Generated_code_hook.nop ~expect_mismatch_handler:Context_free.Expect_mismatch_handler.nop - ~input_name:None ~embed_errors:false + ~input_name:None ~embed_errors:false ~no_corrections:false with | ast -> ast @@ -1038,13 +1039,13 @@ struct end let process_ast (ast : Intf_or_impl.t) ~input_name ~tool_name ~hook - ~expect_mismatch_handler ~embed_errors = + ~expect_mismatch_handler ~embed_errors ~no_corrections = match ast with | Intf x -> let ast = match map_signature_gen x ~tool_name ~hook ~expect_mismatch_handler - ~input_name:(Some input_name) ~embed_errors + ~input_name:(Some input_name) ~embed_errors ~no_corrections with | ast -> ast in @@ -1053,14 +1054,14 @@ let process_ast (ast : Intf_or_impl.t) ~input_name ~tool_name ~hook let ast = match map_structure_gen x ~tool_name ~hook ~expect_mismatch_handler - ~input_name:(Some input_name) ~embed_errors + ~input_name:(Some input_name) ~embed_errors ~no_corrections with | ast -> ast in Intf_or_impl.Impl ast let process_file (kind : Kind.t) fn ~input_name ~relocate ~output_mode - ~embed_errors ~output = + ~embed_errors ~no_corrections ~output = File_property.reset_all (); List.iter (List.rev !process_file_hooks) ~f:(fun f -> f ()); corrections := []; @@ -1098,7 +1099,7 @@ let process_file (kind : Kind.t) fn ~input_name ~relocate ~output_mode let ast = extract_cookies ast |> process_ast ~input_name ~tool_name ~hook ~expect_mismatch_handler - ~embed_errors + ~embed_errors ~no_corrections in (input_fname, input_version, ast) with exn when embed_errors -> @@ -1450,7 +1451,7 @@ let standalone_main () = match !loc_fname with None -> (fn, false) | Some fn -> (fn, true) in process_file kind fn ~input_name ~relocate ~output_mode:!output_mode - ~output:!output ~embed_errors:!embed_errors + ~output:!output ~embed_errors:!embed_errors ~no_corrections:!no_corrections let rewrite_binary_ast_file input_fn output_fn = let input_name, input_version, ast = load_input_run_as_ppx input_fn in @@ -1461,7 +1462,7 @@ let rewrite_binary_ast_file input_fn output_fn = let hook = Context_free.Generated_code_hook.nop in let expect_mismatch_handler = Context_free.Expect_mismatch_handler.nop in process_ast ast ~input_name ~tool_name ~hook ~expect_mismatch_handler - ~embed_errors:true + ~embed_errors:true ~no_corrections:false with exn -> exn_to_extension exn ~kind:(Intf_or_impl.kind ast) in with_output (Some output_fn) ~binary:true ~f:(fun oc ->