From 95794fe97079da80eb04c55c273c04f86fe87b01 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Wed, 9 Jul 2025 13:23:11 +0200 Subject: [PATCH 1/3] wip migrate command --- analysis/src/Cmt.ml | 14 ++ compiler/ml/builtin_attributes.ml | 40 ++++- compiler/ml/cmt_format.ml | 11 +- compiler/ml/cmt_format.mli | 4 + compiler/ml/cmt_utils.ml | 11 ++ .../src/expected/DeprecatedStuff.res.expected | 1 + .../src/expected/FileToMigrate.res.expected | 6 + .../src/migrate/DeprecatedStuff.res | 9 + .../tools_tests/src/migrate/FileToMigrate.res | 9 + tests/tools_tests/test.sh | 10 ++ tools/bin/main.ml | 10 ++ tools/src/tools.ml | 161 ++++++++++++++++++ 12 files changed, 283 insertions(+), 3 deletions(-) create mode 100644 compiler/ml/cmt_utils.ml create mode 100644 tests/tools_tests/src/expected/DeprecatedStuff.res.expected create mode 100644 tests/tools_tests/src/expected/FileToMigrate.res.expected create mode 100644 tests/tools_tests/src/migrate/DeprecatedStuff.res create mode 100644 tests/tools_tests/src/migrate/FileToMigrate.res diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index a433d12908..ac1d5ae595 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -51,3 +51,17 @@ let fullsFromModule ~package ~moduleName = let loadFullCmtFromPath ~path = let uri = Uri.fromPath path in fullFromUri ~uri + +let loadCmtInfosFromPath ~path = + let uri = Uri.fromPath path in + match Packages.getPackage ~uri with + | None -> None + | Some package -> ( + let moduleName = + BuildSystem.namespacedName package.namespace (FindFiles.getName path) + in + match Hashtbl.find_opt package.pathsForModule moduleName with + | Some paths -> + let cmt = getCmtPath ~uri paths in + Shared.tryReadCmt cmt + | None -> None) diff --git a/compiler/ml/builtin_attributes.ml b/compiler/ml/builtin_attributes.ml index 5d110eda75..846e8e77cb 100644 --- a/compiler/ml/builtin_attributes.ml +++ b/compiler/ml/builtin_attributes.ml @@ -79,10 +79,46 @@ let rec deprecated_of_attrs = function Some (string_of_opt_payload p) | _ :: tl -> deprecated_of_attrs tl +let rec deprecated_of_attrs_with_migrate = function + | [] -> None + | ( {txt = "deprecated"; _}, + PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record (fields, _)}, _)}] + ) + :: _ -> ( + let reason = + fields + |> List.find_map (fun field -> + match field with + | { + lid = {txt = Lident "reason"}; + x = {pexp_desc = Pexp_constant (Pconst_string (reason, _))}; + } -> + Some reason + | _ -> None) + in + let migration_template = + fields + |> List.find_map (fun field -> + match field with + | {lid = {txt = Lident "migrate"}; x = migration_template} -> + Some migration_template + | _ -> None) + in + + (* TODO: Validate and error if expected shape mismatches *) + match reason with + | Some reason -> Some (reason, migration_template) + | None -> None) + | ({txt = "ocaml.deprecated" | "deprecated"; _}, p) :: _ -> + Some (string_of_opt_payload p, None) + | _ :: tl -> deprecated_of_attrs_with_migrate tl + let check_deprecated loc attrs s = - match deprecated_of_attrs attrs with + match deprecated_of_attrs_with_migrate attrs with | None -> () - | Some txt -> Location.deprecated loc (cat s txt) + | Some (txt, migration_template) -> + !Cmt_utils.record_deprecated_used loc txt migration_template; + Location.deprecated loc (cat s txt) let check_deprecated_inclusion ~def ~use loc attrs1 attrs2 s = match (deprecated_of_attrs attrs1, deprecated_of_attrs attrs2) with diff --git a/compiler/ml/cmt_format.ml b/compiler/ml/cmt_format.ml index 907f2e7122..cb566738ad 100644 --- a/compiler/ml/cmt_format.ml +++ b/compiler/ml/cmt_format.ml @@ -63,6 +63,7 @@ type cmt_infos = { cmt_imports : (string * Digest.t option) list; cmt_interface_digest : Digest.t option; cmt_use_summaries : bool; + cmt_extra_info: Cmt_utils.cmt_extra_info; } type error = @@ -154,15 +155,22 @@ let read_cmi filename = let saved_types = ref [] let value_deps = ref [] +let deprecated_used = ref [] let clear () = saved_types := []; - value_deps := [] + value_deps := []; + deprecated_used := [] let add_saved_type b = saved_types := b :: !saved_types let get_saved_types () = !saved_types let set_saved_types l = saved_types := l +let record_deprecated_used source_loc deprecated_text migration_template = + deprecated_used := {Cmt_utils.source_loc; deprecated_text; migration_template} :: !deprecated_used + +let _ = Cmt_utils.record_deprecated_used := record_deprecated_used + let record_value_dependency vd1 vd2 = if vd1.Types.val_loc <> vd2.Types.val_loc then value_deps := (vd1, vd2) :: !value_deps @@ -197,6 +205,7 @@ let save_cmt filename modname binary_annots sourcefile initial_env cmi = cmt_imports = List.sort compare (Env.imports ()); cmt_interface_digest = this_crc; cmt_use_summaries = need_to_clear_env; + cmt_extra_info = {deprecated_used = !deprecated_used}; } in output_cmt oc cmt) end; diff --git a/compiler/ml/cmt_format.mli b/compiler/ml/cmt_format.mli index 1a84aa68d0..d59a5053b5 100644 --- a/compiler/ml/cmt_format.mli +++ b/compiler/ml/cmt_format.mli @@ -63,6 +63,7 @@ type cmt_infos = { cmt_imports: (string * Digest.t option) list; cmt_interface_digest: Digest.t option; cmt_use_summaries: bool; + cmt_extra_info: Cmt_utils.cmt_extra_info; } type error = Not_a_typedtree of string @@ -111,6 +112,9 @@ val set_saved_types : binary_part list -> unit val record_value_dependency : Types.value_description -> Types.value_description -> unit +val record_deprecated_used : + Location.t -> string -> Parsetree.expression option -> unit + (* val is_magic_number : string -> bool diff --git a/compiler/ml/cmt_utils.ml b/compiler/ml/cmt_utils.ml new file mode 100644 index 0000000000..fd73347a05 --- /dev/null +++ b/compiler/ml/cmt_utils.ml @@ -0,0 +1,11 @@ +type deprecated_used = { + source_loc: Location.t; + deprecated_text: string; + migration_template: Parsetree.expression option; +} + +type cmt_extra_info = {deprecated_used: deprecated_used list} + +let record_deprecated_used : + (Location.t -> string -> Parsetree.expression option -> unit) ref = + ref (fun _ _ _ -> ()) diff --git a/tests/tools_tests/src/expected/DeprecatedStuff.res.expected b/tests/tools_tests/src/expected/DeprecatedStuff.res.expected new file mode 100644 index 0000000000..4e72aff940 --- /dev/null +++ b/tests/tools_tests/src/expected/DeprecatedStuff.res.expected @@ -0,0 +1 @@ +DeprecatedStuff.res: File did not need migration diff --git a/tests/tools_tests/src/expected/FileToMigrate.res.expected b/tests/tools_tests/src/expected/FileToMigrate.res.expected new file mode 100644 index 0000000000..d1a1b3ceab --- /dev/null +++ b/tests/tools_tests/src/expected/FileToMigrate.res.expected @@ -0,0 +1,6 @@ +let someNiceString = String.slice("abcdefg", ~start=2, ~end=5) + +let someNiceString2 = String.slice(String.slice("abcdefg", ~start=0, ~end=1), ~start=2, ~end=5) + +let someNiceString3 = "abcdefg"->String.slice(~start=2, ~end=5) + diff --git a/tests/tools_tests/src/migrate/DeprecatedStuff.res b/tests/tools_tests/src/migrate/DeprecatedStuff.res new file mode 100644 index 0000000000..de4f39fe0b --- /dev/null +++ b/tests/tools_tests/src/migrate/DeprecatedStuff.res @@ -0,0 +1,9 @@ +@deprecated({ + reason: "Use `String.slice` instead", + migrate: String.slice( + ~start=%insert.labelledArgument("from"), + ~end=%insert.labelledArgument("to_"), + ), +}) +@send +external slice: (string, ~from: int, ~to_: int) => string = "slice" diff --git a/tests/tools_tests/src/migrate/FileToMigrate.res b/tests/tools_tests/src/migrate/FileToMigrate.res new file mode 100644 index 0000000000..dc241cc5ee --- /dev/null +++ b/tests/tools_tests/src/migrate/FileToMigrate.res @@ -0,0 +1,9 @@ +let someNiceString = DeprecatedStuff.slice("abcdefg", ~from=2, ~to_=5) + +let someNiceString2 = DeprecatedStuff.slice( + DeprecatedStuff.slice("abcdefg", ~from=0, ~to_=1), + ~from=2, + ~to_=5, +) + +let someNiceString3 = "abcdefg"->DeprecatedStuff.slice(~from=2, ~to_=5) diff --git a/tests/tools_tests/test.sh b/tests/tools_tests/test.sh index 73e42acfd6..2d69e9e9fa 100755 --- a/tests/tools_tests/test.sh +++ b/tests/tools_tests/test.sh @@ -33,6 +33,16 @@ for file in src/docstrings-format/*.{res,resi,md}; do fi done +# Test migrate command +for file in src/migrate/*.{res,resi}; do + output="src/expected/$(basename $file).expected" + ../../_build/install/default/bin/rescript-tools migrate "$file" --stdout > $output + # # CI. We use LF, and the CI OCaml fork prints CRLF. Convert. + if [ "$RUNNER_OS" == "Windows" ]; then + perl -pi -e 's/\r\n/\n/g' -- $output + fi +done + warningYellow='\033[0;33m' successGreen='\033[0;32m' reset='\033[0m' diff --git a/tools/bin/main.ml b/tools/bin/main.ml index 88f7ffa575..6f1a76ff45 100644 --- a/tools/bin/main.ml +++ b/tools/bin/main.ml @@ -32,6 +32,7 @@ Usage: rescript-tools [command] Commands: +migrate [--stdout] Runs the migration tool on the given file doc Generate documentation format-codeblocks Format ReScript code blocks [--stdout] Output to stdout @@ -66,6 +67,15 @@ let main () = in logAndExit (Tools.extractDocs ~entryPointFile:path ~debug:false) | _ -> logAndExit (Error docHelp)) + | "migrate" :: file :: opts -> ( + let isStdout = List.mem "--stdout" opts in + let outputMode = if isStdout then `Stdout else `File in + match + (Tools.Migrate.migrate ~entryPointFile:file ~outputMode, outputMode) + with + | Ok content, `Stdout -> print_endline content + | result, `File -> logAndExit result + | Error e, _ -> logAndExit (Error e)) | "format-codeblocks" :: rest -> ( match rest with | ["-h"] | ["--help"] -> logAndExit (Ok formatCodeblocksHelp) diff --git a/tools/src/tools.ml b/tools/src/tools.ml index 1722fdda07..b7e51dc192 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -1292,3 +1292,164 @@ module ExtractCodeblocks = struct ]) |> Protocol.array) end + +module StringMap = Map.Make (String) + +module Migrate = struct + let makeMapper (deprecated_used : Cmt_utils.deprecated_used list) = + let loc_to_deprecated_use = Hashtbl.create (List.length deprecated_used) in + deprecated_used + |> List.iter (fun ({Cmt_utils.source_loc} as d) -> + Hashtbl.replace loc_to_deprecated_use source_loc d); + let mapper = + { + Ast_mapper.default_mapper with + expr = + (fun mapper exp -> + match exp with + | { + pexp_desc = + Pexp_apply {funct = {pexp_loc = fn_loc}; args = source_args}; + } + when Hashtbl.mem loc_to_deprecated_use fn_loc -> ( + let deprecated_info = Hashtbl.find loc_to_deprecated_use fn_loc in + Hashtbl.remove loc_to_deprecated_use fn_loc; + + let source_args = + source_args + |> List.map (fun (label, arg) -> + (label, mapper.expr mapper arg)) + in + + (* TODO: Here we could add strict and partial mode, to control if args are merged or not. *) + match deprecated_info.migration_template with + | Some + { + pexp_desc = + Pexp_apply + { + funct = template_funct; + args = template_args; + partial; + transformed_jsx; + }; + } -> + let labelled_args_map = + template_args + |> List.filter_map (fun (label, arg) -> + match (label, arg) with + | ( ( Asttypes.Labelled {txt = label} + | Optional {txt = label} ), + { + Parsetree.pexp_desc = + Pexp_extension + ( {txt = "insert.labelledArgument"}, + PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = + Pexp_constant + (Pconst_string + (arg_name, _)); + }, + _ ); + }; + ] ); + } ) -> + Some (arg_name, label) + | _ -> None) + |> StringMap.of_list + in + { + exp with + pexp_desc = + Pexp_apply + { + funct = template_funct; + args = + source_args + |> List.map (fun (label, arg) -> + match label with + | Asttypes.Labelled {loc; txt = label} + | Asttypes.Optional {loc; txt = label} + when StringMap.mem label labelled_args_map -> + let mapped_label_name = + StringMap.find label labelled_args_map + in + ( Asttypes.Labelled + {loc; txt = mapped_label_name}, + arg ) + | label -> (label, arg)); + partial; + transformed_jsx; + }; + } + | _ -> + (* TODO: More elaborate warnings etc *) + (* Invalid config. *) + exp) + | _ -> Ast_mapper.default_mapper.expr mapper exp); + } + in + mapper + + let migrate ~entryPointFile ~outputMode = + let path = + match Filename.is_relative entryPointFile with + | true -> Unix.realpath entryPointFile + | false -> entryPointFile + in + let result = + if Filename.check_suffix path ".res" then + let parser = + Res_driver.parsing_engine.parse_implementation ~for_printer:true + in + let {Res_driver.parsetree; comments; source} = parser ~filename:path in + match Cmt.loadCmtInfosFromPath ~path with + | None -> + Error + (Printf.sprintf + "error: failed to run migration for %s because build artifacts \ + could not be found. try to build the project" + path) + | Some {cmt_extra_info = {deprecated_used}} -> + let mapper = makeMapper deprecated_used in + let astMapped = mapper.structure mapper parsetree in + Ok + ( Res_printer.print_implementation + ~width:Res_printer.default_print_width astMapped ~comments, + source ) + else if Filename.check_suffix path ".resi" then + let parser = + Res_driver.parsing_engine.parse_interface ~for_printer:true + in + let {Res_driver.parsetree = signature; comments; source} = + parser ~filename:path + in + let mapper = makeMapper [] in + let astMapped = mapper.signature mapper signature in + Ok + ( Res_printer.print_interface ~width:Res_printer.default_print_width + astMapped ~comments, + source ) + else + Error + (Printf.sprintf + "File extension not supported. This command accepts .res, .resi \ + files") + in + match result with + | Error e -> Error e + | Ok (contents, source) when contents <> source -> ( + match outputMode with + | `Stdout -> Ok contents + | `File -> + let oc = open_out path in + Printf.fprintf oc "%s" contents; + close_out oc; + Ok (Filename.basename path ^ ": File migrated successfully")) + | Ok _ -> Ok (Filename.basename path ^ ": File did not need migration") +end From a98f6f1bbfb23e69dbddb19b42c50d422f8734be Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 10 Jul 2025 10:09:05 +0200 Subject: [PATCH 2/3] fix --- .../src/expected/DeprecatedStuff.resi.expected | 1 + tests/tools_tests/src/migrate/DeprecatedStuff.res | 7 ------- tests/tools_tests/src/migrate/DeprecatedStuff.resi | 9 +++++++++ 3 files changed, 10 insertions(+), 7 deletions(-) create mode 100644 tests/tools_tests/src/expected/DeprecatedStuff.resi.expected create mode 100644 tests/tools_tests/src/migrate/DeprecatedStuff.resi diff --git a/tests/tools_tests/src/expected/DeprecatedStuff.resi.expected b/tests/tools_tests/src/expected/DeprecatedStuff.resi.expected new file mode 100644 index 0000000000..7e76b1c053 --- /dev/null +++ b/tests/tools_tests/src/expected/DeprecatedStuff.resi.expected @@ -0,0 +1 @@ +DeprecatedStuff.resi: File did not need migration diff --git a/tests/tools_tests/src/migrate/DeprecatedStuff.res b/tests/tools_tests/src/migrate/DeprecatedStuff.res index de4f39fe0b..6f0f506779 100644 --- a/tests/tools_tests/src/migrate/DeprecatedStuff.res +++ b/tests/tools_tests/src/migrate/DeprecatedStuff.res @@ -1,9 +1,2 @@ -@deprecated({ - reason: "Use `String.slice` instead", - migrate: String.slice( - ~start=%insert.labelledArgument("from"), - ~end=%insert.labelledArgument("to_"), - ), -}) @send external slice: (string, ~from: int, ~to_: int) => string = "slice" diff --git a/tests/tools_tests/src/migrate/DeprecatedStuff.resi b/tests/tools_tests/src/migrate/DeprecatedStuff.resi new file mode 100644 index 0000000000..de4f39fe0b --- /dev/null +++ b/tests/tools_tests/src/migrate/DeprecatedStuff.resi @@ -0,0 +1,9 @@ +@deprecated({ + reason: "Use `String.slice` instead", + migrate: String.slice( + ~start=%insert.labelledArgument("from"), + ~end=%insert.labelledArgument("to_"), + ), +}) +@send +external slice: (string, ~from: int, ~to_: int) => string = "slice" From b485278f99a01c3dcc9d7332c126c809e72d424d Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Mon, 21 Jul 2025 21:34:25 +0200 Subject: [PATCH 3/3] remove comment --- tests/tools_tests/test.sh | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/tools_tests/test.sh b/tests/tools_tests/test.sh index 2d69e9e9fa..700b959b57 100755 --- a/tests/tools_tests/test.sh +++ b/tests/tools_tests/test.sh @@ -37,7 +37,6 @@ done for file in src/migrate/*.{res,resi}; do output="src/expected/$(basename $file).expected" ../../_build/install/default/bin/rescript-tools migrate "$file" --stdout > $output - # # CI. We use LF, and the CI OCaml fork prints CRLF. Convert. if [ "$RUNNER_OS" == "Windows" ]; then perl -pi -e 's/\r\n/\n/g' -- $output fi