support value references

Author: zth

compiler/ml/cmt_utils.ml

@@ -1,4 +1,4 @@
-type deprecated_used_context = FunctionCall
+type deprecated_used_context = FunctionCall | Reference
 
 type deprecated_used = {
   source_loc: Location.t;

compiler/ml/typecore.ml

@@ -2263,7 +2263,12 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected)
   match sexp.pexp_desc with
   | Pexp_ident lid ->
     let path, desc =
-      Typetexp.find_value ?deprecated_context env lid.loc lid.txt
+      Typetexp.find_value
+        ?deprecated_context:
+          (match deprecated_context with
+          | None -> Some Reference
+          | v -> v)
+        env lid.loc lid.txt
     in
     (if !Clflags.annotations then
        let dloc = desc.Types.val_loc in

tests/tools_tests/src/expected/FileToMigrate.res.expected

@@ -7,3 +7,5 @@ let someNiceString3 = "abcdefg"->String.slice(~start=2, ~end=5)
 let shift1 = Array.shift([1, 2, 3])
 let shift2 = [1, 2, 3]->Array.shift
 
+let deprecatedThing1 = DeprecatedStuff.Constants.otherThing
+

tests/tools_tests/src/migrate/DeprecatedStuff.res

@@ -3,3 +3,9 @@ external slice: (string, ~from: int, ~to_: int) => string = "slice"
 
 @send
 external shift: array<'a> => option<'a> = "shift"
+
+module Constants = {
+  let otherThing = [2, 3]
+}
+
+let deprecatedThing = [1, 2]

tests/tools_tests/src/migrate/DeprecatedStuff.resi

@@ -14,3 +14,13 @@ external slice: (string, ~from: int, ~to_: int) => string = "slice"
   migrate: Array.shift(),
 })
 external shift: array<'a> => option<'a> = "shift"
+
+module Constants: {
+  let otherThing: array<int>
+}
+
+@deprecated({
+  reason: "Use `otherThing` instead.",
+  migrate: DeprecatedStuff.Constants.otherThing,
+})
+let deprecatedThing: array<int>

tests/tools_tests/src/migrate/FileToMigrate.res

@@ -10,3 +10,5 @@ let someNiceString3 = "abcdefg"->DeprecatedStuff.slice(~from=2, ~to_=5)
 
 let shift1 = DeprecatedStuff.shift([1, 2, 3])
 let shift2 = [1, 2, 3]->DeprecatedStuff.shift
+
+let deprecatedThing1 = DeprecatedStuff.deprecatedThing

tests/tools_tests/src/migrate/migrated/Migrated_StdlibMigration_Array.res

@@ -166,3 +166,4 @@ let reduceRight2 = Array.reduceRight([1, 2, 3], 0, (acc, x) => acc + x)
 
 let reduceRighti1 = [1, 2, 3]->Array.reduceRightWithIndex(0, (acc, x, i) => acc + x + i)
 let reduceRighti2 = Array.reduceRightWithIndex([1, 2, 3], 0, (acc, x, i) => acc + x + i)
+

tools/src/tools.ml

@@ -1486,6 +1486,7 @@ module Migrate = struct
   end
 
   let makeMapper (deprecated_used : Cmt_utils.deprecated_used list) =
+    (* Function calls *)
     let deprecated_function_calls =
       deprecated_used
       |> List.filter (fun (d : Cmt_utils.deprecated_used) ->
@@ -1499,6 +1500,22 @@ module Migrate = struct
     deprecated_function_calls
     |> List.iter (fun ({Cmt_utils.source_loc} as d) ->
            Hashtbl.replace loc_to_deprecated_fn_call source_loc d);
+
+    (* References *)
+    let deprecated_references =
+      deprecated_used
+      |> List.filter (fun (d : Cmt_utils.deprecated_used) ->
+             match d.context with
+             | Some Reference -> true
+             | _ -> false)
+    in
+    let loc_to_deprecated_reference =
+      Hashtbl.create (List.length deprecated_references)
+    in
+    deprecated_references
+    |> List.iter (fun ({Cmt_utils.source_loc} as d) ->
+           Hashtbl.replace loc_to_deprecated_reference source_loc d);
+
     let mapper =
       {
         Ast_mapper.default_mapper with
@@ -1513,6 +1530,16 @@ module Migrate = struct
         expr =
           (fun mapper exp ->
             match exp with
+            | {pexp_desc = Pexp_ident {loc}}
+              when Hashtbl.mem loc_to_deprecated_reference loc -> (
+              (* Map references to their migration template. *)
+              let deprecated_info =
+                Hashtbl.find loc_to_deprecated_reference loc
+              in
+              Hashtbl.remove loc_to_deprecated_reference loc;
+              match deprecated_info.migration_template with
+              | None -> exp
+              | Some e -> e)
             | {
              pexp_desc =
                Pexp_apply {funct = {pexp_loc = fn_loc}; args = source_args};