Initialize typing env with stdlib (#135)

azzsal · web-flow · commit bfe1ad1c13f7 · 2025-03-25T10:08:38.000+01:00
* Initialize typing env with stdlib

* Add test

* Init env with stdlib in unit tests

* Add change log entry

* Update test description

* Fix failing test for functor paramters

* Format

* Minor fixes
diff --git a/CHANGES.md b/CHANGES.md
@@ -26,6 +26,7 @@
     changes in a line (#126,@azzsal)
   - Improve handling of type equalities across the reference and current
     versions of the interface. (#134, @azzsal)
+  - Initialize the typing enviorment with the standard library
 
 ### Deprecated
 
diff --git a/lib/api_watch.ml b/lib/api_watch.ml
@@ -5,3 +5,4 @@ module Library = Library
 module Normalize = Normalize
 module Stddiff = Stddiff
 module Ocaml_types = Ocaml_types
+module Typing_env = Typing_env
diff --git a/lib/diff.ml b/lib/diff.ml
@@ -531,6 +531,7 @@ and module_type ~typing_env ~name ~ref_module_type ~current_module_type
         ~reference:ref_modtype ~current:curr_modtype
 
 and signatures ~reference ~current =
+  let initialized_env = Typing_env.initialized_env () in
   let modified_reference, modified_current, typing_env =
     Typing_env.for_diff ~reference ~current
   in
@@ -539,10 +540,10 @@ and signatures ~reference ~current =
   with
   | [] -> (
       let coercion1 () =
-        Includemod.signatures Env.empty ~mark:Mark_both reference current
+        Includemod.signatures initialized_env ~mark:Mark_both reference current
       in
       let coercion2 () =
-        Includemod.signatures Env.empty ~mark:Mark_both current reference
+        Includemod.signatures initialized_env ~mark:Mark_both current reference
       in
       match (coercion1 (), coercion2 ()) with
       | Tcoerce_none, Tcoerce_none -> None
diff --git a/lib/typing_env.ml b/lib/typing_env.ml
@@ -45,19 +45,34 @@ let replace_matching_ids ~reference ~current =
                   Sig_type (new_id, td, r, v) :: lst )
             | None -> (subst, sig_typ_decl :: lst))
         | Sig_module (id, mp, md, r, v) as sig_mod_decl -> (
-            match Env.find_value_index id ref_env with
+            match Env.find_module_index id ref_env with
             | Some _ ->
                 let new_id = Ident.rename id in
                 ( Subst.add_module id (Path.Pident new_id) subst,
                   Sig_module (new_id, mp, md, r, v) :: lst )
             | None -> (subst, sig_mod_decl :: lst))
-        | Sig_modtype (id, mtd, v) as sig_modtyp_decl -> (
+        | Sig_modtype (id, mtd, v) -> (
             match Env.find_modtype_index id ref_env with
             | Some _ ->
                 let new_id = Ident.rename id in
                 ( Subst.add_modtype id (Mty_ident (Pident new_id)) subst,
                   Sig_modtype (new_id, mtd, v) :: lst )
-            | None -> (subst, sig_modtyp_decl :: lst))
+            | None ->
+                (* This is a special case for functor paramters.
+                   When two functors have different parameters,
+                   they might treated equally by Includemod.modtypes, thus
+                   one of parameters' id has to be rewritten. For example:
+                   module F (M : X) : A and module F (M : Y) : A
+                   X and Y could have the same stamp, thus they would be
+                   treated equally, so Y stamp has to be rewritten.
+                   Note: This should be removed once we have fine-grained
+                   diffing of functors *)
+                let new_id = ref (Ident.rename id) in
+                while Option.is_some (Env.find_modtype_index !new_id ref_env) do
+                  new_id := Ident.rename id
+                done;
+                ( Subst.add_modtype id (Mty_ident (Pident !new_id)) subst,
+                  Sig_modtype (!new_id, mtd, v) :: lst ))
         | Sig_value (id, vd, v) as sig_val -> (
             match Env.find_value_index id ref_env with
             | Some _ ->
@@ -117,9 +132,17 @@ let pair_items ~reference ~current =
       | _ -> subst)
     Subst.identity current
 
+let initialized_env =
+  Compmisc.init_path ();
+  let env = Compmisc.initial_env () in
+  fun () -> env
+
 let for_diff ~reference ~current =
   let current = replace_matching_ids ~reference ~current in
-  let env = Env.add_signature reference (Env.in_signature true Env.empty) in
+  let reference = replace_matching_ids ~reference:current ~current:reference in
+  let env =
+    Env.add_signature reference (Env.in_signature true (initialized_env ()))
+  in
   let env = Env.add_signature current env in
   let subst = pair_items ~reference ~current in
   let modified_current = apply_subst subst current in
@@ -155,6 +178,10 @@ let pp fmt t =
               (match mp with
               | Mp_present -> "Mp_present"
               | Mp_absent -> "Mp_absent");
+            (match md_type with
+            | Mty_functor (Named (Some pid, _pmt), _fmt) ->
+                Ident.print Format.std_formatter pid
+            | _ -> ());
             Format.fprintf fmt "%a" Printtyp.modtype md_type)
     | Env_modtype (s, id, mtyp) ->
         pp_rec s;
diff --git a/lib/typing_env.mli b/lib/typing_env.mli
@@ -4,6 +4,9 @@ open Types
 
 type t = Env.t
 
+val initialized_env : unit -> t
+(** Returns a environment initialized with the standard library. *)
+
 val for_diff :
   reference:signature -> current:signature -> signature * signature * t
 (** Returns two modified signatures with unique IDs that are suitable
diff --git a/tests/api-diff/stdlib.t b/tests/api-diff/stdlib.t
@@ -0,0 +1,23 @@
+Here we generate a `.mli` file with a type alias referencing a standard library type
+
+  $ cat > ref.mli << EOF
+  > type t = String.t
+  > EOF
+
+We generate the .cmi file
+
+  $ ocamlc ref.mli
+
+# A type that references the same type in the standard library
+
+  $ cat > cur.mli << EOF
+  > type t = string
+  > EOF
+
+We generate the .cmi file
+
+  $ ocamlc cur.mli
+
+Run the api-watcher on the two cmi files, there should be no diff
+
+  $ api-diff ref.cmi cur.cmi
diff --git a/tests/api-watch/stdlib.ml b/tests/api-watch/stdlib.ml
@@ -0,0 +1,9 @@
+open Api_watch
+open Test_helpers
+
+let%expect_test "Identical types" =
+  let reference = compile_interface {| type t = String.t |} in
+  let current = compile_interface {| type t = string |} in
+  let result = Diff.interface ~module_name:"Main" ~reference ~current in
+  Format.printf "%a" pp_diff_option result;
+  [%expect {| None |}]
diff --git a/tests/api-watch/test_diff_module.ml b/tests/api-watch/test_diff_module.ml
@@ -34,7 +34,7 @@ let%expect_test "Modules with multiple value and submodule changes" =
     compile_interface
       {|
     type ('a, 'b) result = Ok of 'a | Error of 'b
-    val a : string -> int 
+    val a : string -> int
     val f : int -> string
     module M : sig
       val b : int list -> int
@@ -89,7 +89,7 @@ let%expect_test "Modules with both supported and unsupported changes" =
     Some (Module Main: {Modified (Supported [ Value (x, Removed);
     Module M: {Modified (Unsupported)}])})|}]
 
-let%expect_test "Submodules with different functor types" =
+let%expect_test "Submodules with different functor types." =
   let reference =
     compile_interface
       {|
diff --git a/tests/test_helpers/test_helpers.ml b/tests/test_helpers/test_helpers.ml
@@ -1,4 +1,5 @@
 open Api_watch.Diff
+open Api_watch.Typing_env
 
 let rec pp_module_modification fmt = function
   | Unsupported -> Format.fprintf fmt "Unsupported"
@@ -67,10 +68,7 @@ let parse_interface content =
   Parse.interface lexbuf
 
 let generate_signature intf =
-  let typing_env =
-    Typemod.initial_env ~loc:Location.none ~initially_opened_module:None
-      ~open_implicit_modules:[]
-  in
+  let typing_env = initialized_env () in
   let typed_tree = Typemod.type_interface typing_env intf in
   typed_tree.sig_type
 
