diff --git a/changes/type-path-memo.polish.md b/changes/type-path-memo.polish.md
new file mode 100644
index 0000000000..570205b4ec
--- /dev/null
+++ b/changes/type-path-memo.polish.md
@@ -0,0 +1 @@
+- Build: remember type path lookups within a compilation, which avoids looking up the same types such as `option` and `string` hundreds of thousands of times per build.
diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml
index 7b86f96de7..1816866950 100644
--- a/compiler/ml/ctype.ml
+++ b/compiler/ml/ctype.ml
@@ -1206,11 +1206,11 @@ let expand_abbrev_gen kind find_type_expansion env ty =
       ty'
     | None -> (
       match find_type_expansion path env with
-      | exception Not_found ->
+      | exception Not_found -> (
         (* another way to expand is to normalize the path itself *)
-        let path' = Env.normalize_path None env path in
-        if Path.same path path' then raise Cannot_expand
-        else newty2 level (Tconstr (path', args, abbrev))
+        match Env.normalize_type_path env path with
+        | None -> raise Cannot_expand
+        | Some path' -> newty2 level (Tconstr (path', args, abbrev)))
       | params, body, lv ->
         (* prerr_endline
            ("add a "^string_of_kind kind^" expansion for "^Path.name path);*)
diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml
index 0659044773..9f9040f9f7 100644
--- a/compiler/ml/env.ml
+++ b/compiler/ml/env.ml
@@ -549,11 +549,156 @@ type pers_struct = {
   ps_filename: string;
 }
 
+(* Request-local memo of type path lookups ([find_type_full] on regular
+   paths) and of [normalize_path] calls that leave a type path unchanged.
+
+   The typechecker resolves the same type paths over and over (expanding
+   [option], [Js.Null.t], ... in [expand_head], [update_level], [occur_univar],
+   ...), each time walking the [open] layers of [env.types] or the components
+   of a persistent module. Both lookups only read immutable environment tables
+   ([env.types] for [Pident] type paths, [env.components] for [Pdot] ones,
+   [env.modules] and [env.components] for normalization) plus request-wide
+   state that only grows: persistent structures (replacing one starts a new
+   memo epoch, see [add_persistent_structure]) and module components, which
+   are forced at most once. An entry is therefore
+   reused only when the tables it read are physically the same, and only
+   successful results are stored. A repeated call has no side effect the memo
+   would skip: the first, uncached call already loaded the [.cmi]s and forced
+   the lazy components it needed. Paths that contain a functor application are
+   never cached ([find_module_descr] applies the functor against [env]), and
+   the memo is bypassed while [.cmi] loading is disabled ([without_cmis] may
+   backtrack components). *)
+module Type_path_memo = struct
+  (* Powers of two. A table starts empty, and only allocates its first array
+     when it stores an entry, so that a process that doesn't typecheck (such as
+     a parse with -bs-ast) allocates none. It grows when it has stored as many
+     entries as it has slots since it last grew, which keeps a small
+     compilation from allocating the full size. *)
+  let initial_size = 64
+  let max_size = 4096
+
+  let string_hash s =
+    let n = String.length s in
+    if n = 0 then 0
+    else
+      (n * 31)
+      + (Char.code (String.unsafe_get s 0) * 7)
+      + Char.code (String.unsafe_get s (n - 1))
+
+  exception Not_cacheable
+
+  (* Consistent with [equal]: it ignores [pos] and ident flags, which no lookup
+     reads. *)
+  let rec hash (path : Path.t) =
+    match path with
+    | Pident id -> (id.Ident.stamp * 65599) + string_hash id.name
+    | Pdot (p, s, _pos) -> (hash p * 31) + string_hash s
+    | Papply _ -> raise_notrace Not_cacheable
+
+  (* Paths that every lookup in this file resolves identically: identifiers are
+     looked up by name and stamp, and components by name. *)
+  let rec equal (p1 : Path.t) (p2 : Path.t) =
+    p1 == p2
+    ||
+    match (p1, p2) with
+    | Pident id1, Pident id2 ->
+      id1.Ident.stamp = id2.Ident.stamp && String.equal id1.name id2.name
+    | Pdot (p1, s1, _), Pdot (p2, s2, _) -> String.equal s1 s2 && equal p1 p2
+    | _ -> false
+
+  type ('types, 'modules, 'components, 'result) entry = {
+    mutable epoch: unit ref;
+    mutable path: Path.t;
+    mutable types: 'types;
+    mutable modules: 'modules;
+    mutable components: 'components;
+    mutable result: 'result;
+  }
+
+  type ('types, 'modules, 'components, 'result) t = {
+    mutable entries:
+      ('types, 'modules, 'components, 'result) entry option array;
+    mutable stores: int;  (** Since [entries] was allocated. *)
+  }
+
+  let create () = {entries = [||]; stores = 0}
+
+  let clear t = Array.fill t.entries 0 (Array.length t.entries) None
+
+  (* The entry in the slot of a path whose [hash] is [h]. *)
+  let find t h =
+    let entries = t.entries in
+    let n = Array.length entries in
+    if n = 0 then None else Array.unsafe_get entries (h land (n - 1))
+
+  (* Stores an entry in the slot of a path whose [hash] is [h]. An entry is
+     only referenced from its slot, so the one it replaces is updated in place
+     instead of allocating another: a file that declares many types changes
+     [env.types] often, and stores the paths it looks up again each time. *)
+  let store t h ~epoch ~path ~types ~modules ~components ~result =
+    let n = Array.length t.entries in
+    if n = 0 then t.entries <- Array.make initial_size None
+    else if t.stores >= n && n < max_size then (
+      let old = t.entries in
+      let entries = Array.make (n * 2) None in
+      Array.iter
+        (function
+          | None -> ()
+          | Some e as slot ->
+            Array.unsafe_set entries (hash e.path land ((n * 2) - 1)) slot)
+        old;
+      t.entries <- entries;
+      t.stores <- 0);
+    t.stores <- t.stores + 1;
+    let entries = t.entries in
+    let i = h land (Array.length entries - 1) in
+    match Array.unsafe_get entries i with
+    | Some e ->
+      e.epoch <- epoch;
+      e.path <- path;
+      e.types <- types;
+      e.modules <- modules;
+      e.components <- components;
+      e.result <- result
+    | None ->
+      Array.unsafe_set entries i
+        (Some {epoch; path; types; modules; components; result})
+end
+
+(* The tables are allocated once per domain rather than per request: they can
+   grow large, and requests are small. An entry is valid only in the epoch that
+   stored it. Each request starts a fresh epoch (and a nested request restores
+   the outer one when it returns), so entries never cross requests; clearing
+   starts a new epoch too. *)
+let type_path_memo_key =
+  Domain.DLS.new_key (fun () ->
+      (Type_path_memo.create (), Type_path_memo.create ()))
+
+let type_path_memo_epoch_key = Request_local.new_key (fun () -> ref (ref ()))
+let type_path_memo_epoch () = !(Domain.DLS.get type_path_memo_epoch_key)
+
+let clear_type_path_memo_tables () =
+  let found, unchanged = Domain.DLS.get type_path_memo_key in
+  Type_path_memo.clear found;
+  Type_path_memo.clear unchanged
+
+let clear_type_path_memo () =
+  Domain.DLS.get type_path_memo_epoch_key := ref ();
+  clear_type_path_memo_tables ()
+
 let persistent_structures_key =
   Request_local.new_key (fun () ->
       (Hashtbl.create 17 : (string, pers_struct option) Hashtbl.t))
 let persistent_structures () = Domain.DLS.get persistent_structures_key
 
+(* [Hashtbl.add] shadows an earlier binding for [name], which the type path
+   memo may have read (directly, or as a missing module), so replacing one
+   starts a new memo epoch. *)
+let add_persistent_structure name ps =
+  let tbl = persistent_structures () in
+  if Hashtbl.mem tbl name then clear_type_path_memo ();
+  Hashtbl.add tbl name ps
+
 (* Consistency between persistent structures *)
 
 let crc_units_key = Request_local.new_key Consistbl.create
@@ -590,7 +735,7 @@ let check_consistency ps =
 
 let save_pers_struct crc ps =
   let modname = ps.ps_name in
-  Hashtbl.add (persistent_structures ()) modname (Some ps);
+  add_persistent_structure modname (Some ps);
   Consistbl.set (crc_units ()) modname crc ps.ps_filename;
   add_import modname
 
@@ -635,7 +780,7 @@ let acknowledge_pers_struct check modname {Persistent_signature.filename; cmi} =
   if ps.ps_name <> modname then
     error (Illegal_renaming (modname, ps.ps_name, filename));
   if check then check_consistency ps;
-  Hashtbl.add (persistent_structures ()) modname (Some ps);
+  add_persistent_structure modname (Some ps);
   ps
 
 let read_pers_struct check modname filename =
@@ -656,7 +801,7 @@ let find_pers_struct check name =
         match !Persistent_signature.load ~unit_name:name with
         | Some ps -> ps
         | None ->
-          Hashtbl.add (persistent_structures ()) name None;
+          add_persistent_structure name None;
           raise Not_found
       in
       add_import name;
@@ -701,6 +846,7 @@ let check_pers_struct name =
 
 let reset_cache () =
   current_unit () := "";
+  clear_type_path_memo ();
   Hashtbl.clear (persistent_structures ());
   clear_imports ();
   Hashtbl.clear (value_declarations ());
@@ -717,13 +863,16 @@ let reset_cache_toplevel () =
       (persistent_structures ()) []
   in
   List.iter (Hashtbl.remove (persistent_structures ())) l;
+  clear_type_path_memo ();
   Hashtbl.clear (value_declarations ());
   Hashtbl.clear (type_declarations ());
   Hashtbl.clear (module_declarations ());
   Hashtbl.clear (used_constructors ());
   Hashtbl.clear (prefixed_sg ())
 
-let set_unit_name name = current_unit () := name
+let set_unit_name name =
+  clear_type_path_memo ();
+  current_unit () := name
 
 let get_unit_name () = !(current_unit ())
 
@@ -770,11 +919,36 @@ let type_of_cstr path = function
     (d, ([], List.map snd (Datarepr.labels_of_type path d)))
   | _ -> assert false
 
+(* [find_type_full p env] for a regular type path, memoized as described at
+   [Type_path_memo]. *)
+let find_regular_type_full p env =
+  match !(can_load_cmis ()) with
+  | Cannot_load_cmis _ -> find_type_full p env
+  | Can_load_cmis -> (
+    match Type_path_memo.hash p with
+    | exception Type_path_memo.Not_cacheable -> find_type_full p env
+    | h -> (
+      let memo, _ = Domain.DLS.get type_path_memo_key in
+      let epoch = type_path_memo_epoch () in
+      match Type_path_memo.find memo h with
+      | Some e
+        when e.epoch == epoch
+             && (match p with
+               | Pident _ -> e.types == env.types
+               | Pdot _ | Papply _ -> e.components == env.components)
+             && Type_path_memo.equal e.path p ->
+        e.result
+      | _ ->
+        let result = find_type_full p env in
+        Type_path_memo.store memo h ~epoch ~path:p ~types:env.types ~modules:()
+          ~components:env.components ~result;
+        result))
+
 let find_type_full path env =
   match Path.constructor_typath path with
   | Regular p -> (
     try (Path_map.find p env.local_constraints, ([], []))
-    with Not_found -> find_type_full p env)
+    with Not_found -> find_regular_type_full p env)
   | Cstr (ty_path, s) ->
     let _, (cstrs, _) =
       try find_type_full ty_path env with Not_found -> assert false
@@ -881,6 +1055,41 @@ let normalize_path oloc env path =
     | Some loc ->
       raise (Error (Missing_module (loc, path, normalize_path true env path))))
 
+(* [Some (normalize_path None env path)] when normalization changes [path]
+   ([Path.same] is false), [None] when it leaves it unchanged. The unchanged
+   outcome is memoized as described at [Type_path_memo]; a changed path is
+   always computed afresh, so callers get a new path value as before. *)
+(* Not a closure in [normalize_type_path], which would be allocated on every
+   call, hits included. *)
+let normalize_type_path_uncached env path =
+  let path' = normalize_path None env path in
+  if Path.same path path' then None else Some path'
+
+let normalize_type_path env path =
+  match !(can_load_cmis ()) with
+  | Cannot_load_cmis _ -> normalize_type_path_uncached env path
+  | Can_load_cmis -> (
+    match Type_path_memo.hash path with
+    | exception Type_path_memo.Not_cacheable ->
+      normalize_type_path_uncached env path
+    | h -> (
+      let _, memo = Domain.DLS.get type_path_memo_key in
+      let epoch = type_path_memo_epoch () in
+      match Type_path_memo.find memo h with
+      | Some e
+        when e.epoch == epoch && e.modules == env.modules
+             && e.components == env.components
+             && Type_path_memo.equal e.path path ->
+        None
+      | _ ->
+        let result = normalize_type_path_uncached env path in
+        (match result with
+        | None ->
+          Type_path_memo.store memo h ~epoch ~path ~types:()
+            ~modules:env.modules ~components:env.components ~result:()
+        | Some _ -> ());
+        result))
+
 let normalize_path_prefix oloc env path =
   match path with
   | Pdot (p, s, pos) -> Pdot (normalize_path oloc env p, s, pos)
@@ -1953,7 +2162,25 @@ let reset_initial_for_request () =
 let with_fresh_initial action =
   let previous = initial_safe_string () in
   Fun.protect action ~finally:(fun () ->
-      Domain.DLS.set initial_safe_string_key previous)
+      Domain.DLS.set initial_safe_string_key previous;
+      (* The per-domain memo tables would otherwise keep the finished
+         request's environments alive until their slots are overwritten. Their
+         entries are already invalid outside the request's epoch. *)
+      clear_type_path_memo_tables ())
+
+module For_test = struct
+  let type_path_memo_entries () =
+    let found, unchanged = Domain.DLS.get type_path_memo_key in
+    let count (t : _ Type_path_memo.t) =
+      Array.fold_left
+        (fun n e ->
+          match e with
+          | None -> n
+          | Some _ -> n + 1)
+        0 t.entries
+    in
+    count found + count unchanged
+end
 
 let last_env_key = Request_local.new_key (fun () -> ref empty)
 let last_env () = Domain.DLS.get last_env_key
diff --git a/compiler/ml/env.mli b/compiler/ml/env.mli
index a2ebfcaf66..8831acc840 100644
--- a/compiler/ml/env.mli
+++ b/compiler/ml/env.mli
@@ -26,6 +26,8 @@ val empty : t
 val initial_safe_string : unit -> t
 val reset_initial_for_request : unit -> unit
 val with_fresh_initial : (unit -> 'a) -> 'a
+(* Runs a request with its own initial environment; on return, also empties
+   this domain's type path memo. *)
 
 type type_descriptions = constructor_description list * label_description list
 
@@ -65,6 +67,10 @@ val normalize_path : Location.t option -> t -> Path.t -> Path.t
    If the option is None, allow returning dangling paths.
    Otherwise raise a Missing_module error, and may add forgotten
    head as required global. *)
+val normalize_type_path : t -> Path.t -> Path.t option
+(* [normalize_type_path env path] is [Some (normalize_path None env path)] when
+   that differs from [path] according to [Path.same], and [None] otherwise. *)
+
 val normalize_path_prefix : Location.t option -> t -> Path.t -> Path.t
 (* Only normalize the prefix part of the path *)
 
@@ -285,3 +291,8 @@ module Persistent_signature : sig
       the .cmi file in the load path. This function can be overridden to load
       it from memory, for instance to build a self-contained toplevel. *)
 end
+
+module For_test : sig
+  val type_path_memo_entries : unit -> int
+  (** The type path memo entries held on this domain. *)
+end
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index 59ce0e57b7..bcb116cb8d 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -814,9 +814,10 @@ let rec expand_path env p =
     match repr ty with
     | {desc = Tconstr (p, _, _)} -> expand_path env p
     | _ -> p (* PR#6394: recursive module may introduce incoherent manifest *))
-  | _ ->
-    let p' = Env.normalize_path None env p in
-    if Path.same p p' then p else expand_path env p'
+  | _ -> (
+    match Env.normalize_type_path env p with
+    | None -> p
+    | Some p' -> expand_path env p')
 
 let compare_type_path env tpath1 tpath2 =
   Path.same (expand_path env tpath1) (expand_path env tpath2)
diff --git a/tests/build_tests/super_errors/expected/warning_34_unused_type_shadowed.res.expected b/tests/build_tests/super_errors/expected/warning_34_unused_type_shadowed.res.expected
new file mode 100644
index 0000000000..d49d1178e3
--- /dev/null
+++ b/tests/build_tests/super_errors/expected/warning_34_unused_type_shadowed.res.expected
@@ -0,0 +1,47 @@
+
+  Warning number 44
+  /.../fixtures/warning_34_unused_type_shadowed.res:14:3-12
+
+  12 ┆ }
+  13 ┆ 
+  14 ┆ open Inner
+  15 ┆ let w: t = w
+  16 ┆ let v = (Some(String.length(w)): option<int>)
+
+  this open statement shadows the type identifier t (which is later used)
+
+
+  Warning number 34
+  /.../fixtures/warning_34_unused_type_shadowed.res:5:3-22
+
+  3 │   let w: string
+  4 │ } = {
+  5 │   type t = option<int>
+  6 │   type unusedAlias = option<int>
+  7 │ 
+
+  unused type t.
+
+
+  Warning number 34
+  /.../fixtures/warning_34_unused_type_shadowed.res:6:3-32
+
+  4 │ } = {
+  5 │   type t = option<int>
+  6 │   type unusedAlias = option<int>
+  7 │ 
+  8 │   module Inner = {
+
+  unused type unusedAlias.
+
+
+  Warning number 34
+  /.../fixtures/warning_34_unused_type_shadowed.res:10:5-24
+
+   8 ┆ module Inner = {
+   9 ┆   type t = string
+  10 ┆   type unusedInner = t
+  11 ┆   let w: t = "w"
+  12 ┆ }
+
+  unused type unusedInner.
\ No newline at end of file
diff --git a/tests/build_tests/super_errors/fixtures/warning_34_unused_type_shadowed.res b/tests/build_tests/super_errors/fixtures/warning_34_unused_type_shadowed.res
new file mode 100644
index 0000000000..20632507c9
--- /dev/null
+++ b/tests/build_tests/super_errors/fixtures/warning_34_unused_type_shadowed.res
@@ -0,0 +1,17 @@
+module M: {
+  let v: option<int>
+  let w: string
+} = {
+  type t = option<int>
+  type unusedAlias = option<int>
+
+  module Inner = {
+    type t = string
+    type unusedInner = t
+    let w: t = "w"
+  }
+
+  open Inner
+  let w: t = w
+  let v = (Some(String.length(w)): option<int>)
+}
diff --git a/tests/ounit_tests/ounit_compiler_request_tests.ml b/tests/ounit_tests/ounit_compiler_request_tests.ml
index 38278613ad..2465f3f4b9 100644
--- a/tests/ounit_tests/ounit_compiler_request_tests.ml
+++ b/tests/ounit_tests/ounit_compiler_request_tests.ml
@@ -1353,6 +1353,74 @@ let ctype_memo_reset_tests _context =
         (Ctype.For_test.previous_env_is_empty ())
         "the expansion environment does not outlive its request")
 
+(* Consecutive requests reuse identifier stamps, so the same path text with
+   the same stamps names different declarations in each request. Requests that
+   compile such units one after another give the output of cold compiles, and
+   a finished request leaves no type path memo entry behind to keep its
+   environments alive. The memo is also cleared when a request starts
+   ([Env.reset_cache], [Env.set_unit_name]), so this does not exercise the
+   memo's per-environment guards; Ounit_type_path_memo_tests does. *)
+let type_path_memo_isolation_tests _context =
+  with_temp_dir "rewatch-driver-type-path-memo-" (fun root ->
+      let js name = read_file (Filename.concat root (name ^ ".js")) in
+      let compile name =
+        let _, result = run root ~extra:["-I"; root] (name ^ ".res") in
+        assert_equal ~printer:string_of_int 0 result.exit_code
+          ~msg:(name ^ ": " ^ result.stderr)
+      in
+      let unit_source t literal =
+        String.concat "\n"
+          [
+            "type t = " ^ t;
+            "type box = {value: t, next: option<t>}";
+            "let make = (v: t) => {value: v, next: Some(v)}";
+            "let literal: t = " ^ literal;
+            "let boxed = make(literal)";
+            "let value = (b: box): option<t> => b.next";
+            "";
+          ]
+      in
+      write root "IntBox.res" (unit_source "int" "1");
+      write root "StringBox.res" (unit_source "string" "\"one\"");
+      compile "StringBox";
+      let cold_string = js "StringBox" in
+      compile "IntBox";
+      let cold_int = js "IntBox" in
+      assert_equal ~printer:string_of_int 0
+        (Env.For_test.type_path_memo_entries ())
+        ~msg:"the type path memo is empty after a request";
+      compile "StringBox";
+      assert_equal ~printer:Fun.id cold_string (js "StringBox")
+        ~msg:"a request after a same-shaped unit compiles as a cold one";
+      compile "IntBox";
+      assert_equal ~printer:Fun.id cold_int (js "IntBox");
+      (* A unit's types change between requests that look them up. *)
+      write root "Lib.res" "type t = int\nlet zero: t = 0\n";
+      compile "Lib";
+      write root "Use.res" "let one: Lib.t = 1\nlet zero: Lib.t = Lib.zero\n";
+      compile "Use";
+      write root "Lib.res" "type t = string\nlet zero: t = \"\"\n";
+      compile "Lib";
+      let _, stale = run root ~extra:["-I"; root] "Use.res" in
+      assert_equal ~printer:string_of_int 2 stale.exit_code ~msg:"Use";
+      check
+        (contains_text stale.stderr "string")
+        "a later request sees the recompiled unit's type";
+      (* A unit with an interface reads its own .cmi, then records the saved
+         signature for the same name, inside one request. *)
+      write root "Sealed.resi" "type t\nlet make: int => t\nlet get: t => int\n";
+      write root "Sealed.res"
+        "type t = int\nlet make = (n: int): t => n\nlet get = (x: t) => x\n";
+      expect_code 0 (snd (run root ~extra:["-I"; root] "Sealed.resi"));
+      expect_code 0
+        (snd (run root ~extra:["-I"; root; "-bs-read-cmi"] "Sealed.res"));
+      write root "UseSealed.res"
+        "let v = Sealed.get(Sealed.make(2))\nlet w: Sealed.t = Sealed.make(v)\n";
+      compile "UseSealed";
+      write root "Leak.res" "let bad: Sealed.t = 1\n";
+      let _, leaked = run root ~extra:["-I"; root] "Leak.res" in
+      assert_equal ~printer:string_of_int 2 leaked.exit_code ~msg:"Leak")
+
 let package_and_load_path_isolation_tests _context =
   with_temp_dir "rewatch-driver-load-roots-" (fun root ->
       let first = Filename.concat root "first" in
@@ -1717,6 +1785,7 @@ let suites =
          "ctype_level_isolation" >:: ctype_level_isolation_tests;
          "free_variable_isolation" >:: free_variable_isolation_tests;
          "ctype_memo_reset" >:: ctype_memo_reset_tests;
+         "type_path_memo_isolation" >:: type_path_memo_isolation_tests;
          "shared_type_graph_isolation" >:: shared_type_graph_isolation_tests;
          "dependency_extraction_isolation"
          >:: dependency_extraction_isolation_tests;
diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml
index d53bffff6c..a4995fdad9 100644
--- a/tests/ounit_tests/ounit_tests_main.ml
+++ b/tests/ounit_tests/ounit_tests_main.ml
@@ -36,6 +36,7 @@ let suites =
       Ounit_typeopt_tests.suites;
       Ounit_gentype_tests.suites;
       Ounit_compiler_request_tests.suites;
+      Ounit_type_path_memo_tests.suites;
       Ounit_find_in_path_tests.suites;
       Ounit_build_file_store_tests.suites;
     ]
diff --git a/tests/ounit_tests/ounit_type_path_memo_tests.ml b/tests/ounit_tests/ounit_type_path_memo_tests.ml
new file mode 100644
index 0000000000..c57aaf37ad
--- /dev/null
+++ b/tests/ounit_tests/ounit_type_path_memo_tests.ml
@@ -0,0 +1,124 @@
+open Types
+
+let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: ))
+
+(* Env memoizes type path lookups. The same path, with the same identifier
+   stamps, can name different declarations in different environments of one
+   request: typedecl first enters abstract placeholders for a recursive group
+   and then the real declarations under the same identifiers, and recursive
+   modules are typed against an approximation first. Each lookup must answer
+   for the environment it is given, whatever an earlier lookup of the same
+   path cached. *)
+
+let declaration manifest =
+  {
+    type_params = [];
+    type_arity = 0;
+    type_kind = Type_abstract;
+    type_private = Asttypes.Public;
+    type_manifest = manifest;
+    type_variance = [];
+    type_newtype_level = None;
+    type_loc = Location.none;
+    type_attributes = [];
+    type_immediate = false;
+    type_representation = Boxed;
+    type_shape = Unstated;
+    type_inlined_types = [];
+  }
+
+let abstract () = declaration None
+let int_alias () = declaration (Some (Predef.type_int ()))
+
+let has_manifest decl = decl.type_manifest <> None
+
+let check message condition = OUnit.assert_bool message condition
+
+let suites =
+  __FILE__
+  >::: [
+         ( "an identifier bound to different declarations" >:: fun _ ->
+           let id = Ident.create "t" in
+           let placeholder = abstract () and real = int_alias () in
+           let first = Env.add_type ~check:false id placeholder Env.empty in
+           let second = Env.add_type ~check:false id real Env.empty in
+           let path = Path.Pident id in
+           check "the first environment's declaration"
+             (Env.find_type path first == placeholder);
+           check "the second environment's declaration"
+             (Env.find_type path second == real);
+           check "the first environment's declaration again"
+             (Env.find_type path first == placeholder) );
+         ( "a module bound to different signatures" >:: fun _ ->
+           let module_id = Ident.create "M" and type_id = Ident.create "t" in
+           let signature decl =
+             Mty_signature [Sig_type (type_id, decl, Trec_not)]
+           in
+           let approximated =
+             Env.add_module module_id (signature (abstract ())) Env.empty
+           in
+           let real =
+             Env.add_module module_id (signature (int_alias ())) Env.empty
+           in
+           let path = Path.Pdot (Path.Pident module_id, "t", 0) in
+           check "the approximation is abstract"
+             (not (has_manifest (Env.find_type path approximated)));
+           check "the real module has the manifest"
+             (has_manifest (Env.find_type path real));
+           check "the approximation is still abstract"
+             (not (has_manifest (Env.find_type path approximated))) );
+         ( "a module that is an alias in only one environment" >:: fun _ ->
+           let target = Ident.create "Target"
+           and module_id = Ident.create "A" in
+           let type_id = Ident.create "t" in
+           let signature =
+             Mty_signature [Sig_type (type_id, int_alias (), Trec_not)]
+           in
+           let base = Env.add_module target signature Env.empty in
+           let plain = Env.add_module module_id signature base in
+           let alias =
+             Env.add_module module_id
+               (Mty_alias (Mta_present, Path.Pident target))
+               base
+           in
+           let path = Path.Pdot (Path.Pident module_id, "t", 0) in
+           check "a plain module leaves the path unchanged"
+             (Env.normalize_type_path plain path = None);
+           (match Env.normalize_type_path alias path with
+           | Some normalized ->
+             check "an alias normalizes to its target"
+               (Path.same normalized (Path.Pdot (Path.Pident target, "t", 0)))
+           | None -> OUnit.assert_failure "an alias normalizes the path");
+           check "the plain module still leaves the path unchanged"
+             (Env.normalize_type_path plain path = None) );
+         ( "lookups while the memo grows" >:: fun _ ->
+           (* The memo's tables start small and grow, moving their entries, as
+              lookups store more; a replaced entry is updated in place. The
+              test runs in a fresh domain, whose tables start empty. *)
+           Domain.join @@ Domain.spawn
+           @@ fun () ->
+           let bindings =
+             List.init 3000 (fun i ->
+                 (Ident.create (Printf.sprintf "t%d" i), abstract ()))
+           in
+           let env =
+             List.fold_left
+               (fun env (id, decl) -> Env.add_type ~check:false id decl env)
+               Env.empty bindings
+           in
+           let first_id, first_decl = List.hd bindings in
+           let other = Env.add_type ~check:false first_id (int_alias ()) env in
+           let first = Env.find_type (Path.Pident first_id) env in
+           for _ = 1 to 2 do
+             List.iter
+               (fun (id, decl) ->
+                 check "each identifier's declaration"
+                   (Env.find_type (Path.Pident id) env == decl))
+               bindings;
+             check "the other environment's declaration"
+               (has_manifest (Env.find_type (Path.Pident first_id) other))
+           done;
+           check "an earlier result is unchanged" (first == first_decl);
+           check "the memo grew past its first table"
+             (Env.For_test.type_path_memo_entries () > 64) );
+       ]
diff --git a/tests/tests/src/type_path_lookup_test.mjs b/tests/tests/src/type_path_lookup_test.mjs
new file mode 100644
index 0000000000..b83a9c8498
--- /dev/null
+++ b/tests/tests/src/type_path_lookup_test.mjs
@@ -0,0 +1,274 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Mocha from "mocha";
+import * as Test_utils from "./test_utils.mjs";
+import * as Stdlib_List from "@rescript/runtime/lib/es6/Stdlib_List.mjs";
+
+let after = "two";
+
+let Inner = {
+  before: 1,
+  after: after
+};
+
+let Rec = {};
+
+function fromOpen() {
+  return 3;
+}
+
+function afterOpen() {
+  return "after";
+}
+
+let Shadow = {
+  v: 10
+};
+
+function shadowed() {
+  return "shadowed!";
+}
+
+let unshadowed = 11;
+
+let Color = {};
+
+function colourName(c) {
+  if (c === "Red") {
+    return "red";
+  } else {
+    return "green";
+  }
+}
+
+function colorAsColour(c) {
+  return c;
+}
+
+function make(n) {
+  return (n << 1);
+}
+
+function get(n) {
+  return n;
+}
+
+let Counter = {
+  make: make,
+  get: get
+};
+
+function Wrap(V) {
+  let wrapped = V.value;
+  let describe = () => "<" + V.show(wrapped) + ">";
+  return {
+    wrapped: wrapped,
+    describe: describe
+  };
+}
+
+function describe() {
+  return "<" + (4).toString() + ">";
+}
+
+let IntWrap = {
+  wrapped: 4,
+  describe: describe
+};
+
+let value = "s";
+
+function describe$1() {
+  return "<s>";
+}
+
+let StringWrap = {
+  wrapped: value,
+  describe: describe$1
+};
+
+let wrappedSum = 5;
+
+let wrappedString = "s!";
+
+function showPacked(m) {
+  return m.show(m.value);
+}
+
+let packedInt = (7).toString();
+
+function pair(x) {
+  return [
+    x,
+    x
+  ];
+}
+
+let tree = {
+  TAG: "Branch",
+  _0: {hd: {
+    TAG: "Leaf",
+    _0: 1
+  }, tl: {hd: {
+    TAG: "Branch",
+    _0: /* [] */0
+  }, tl: /* [] */0}}
+};
+
+function branchCount(n) {
+  if (n.TAG === "Leaf") {
+    return 0;
+  } else {
+    return Stdlib_List.length(n._0);
+  }
+}
+
+function width(t) {
+  if (typeof t !== "object") {
+    return 0;
+  } else {
+    return Stdlib_List.length(t._0);
+  }
+}
+
+function size(t) {
+  if (typeof t !== "object") {
+    return 1;
+  } else {
+    return 1 + Forest.size(t._0) | 0;
+  }
+}
+
+let Tree = {
+  size: size,
+  width: width
+};
+
+function size$1(f) {
+  return Stdlib_List.reduce(f, 0, (acc, t) => acc + size(t) | 0);
+}
+
+let Forest = {
+  size: size$1
+};
+
+Mocha.describe("Type_path_lookup_test", () => {
+  Mocha.test("shadowed and opened types", () => {
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 171, characters 7-14", [
+      1,
+      "two"
+    ], [
+      1,
+      after
+    ]);
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 172, characters 7-14", [
+      3,
+      "after"
+    ], [
+      3,
+      "after"
+    ]);
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 173, characters 7-14", [
+      "shadowed!",
+      11
+    ], [
+      "shadowed!",
+      unshadowed
+    ]);
+  });
+  Mocha.test("aliases and constraints", () => {
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 176, characters 7-14", [
+      "red",
+      "green"
+    ], [
+      "red",
+      "green"
+    ]);
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 177, characters 7-14", 6, 6);
+  });
+  Mocha.test("functors, first-class and recursive modules", () => {
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 180, characters 7-14", [
+      5,
+      "s!"
+    ], [
+      wrappedSum,
+      wrappedString
+    ]);
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 181, characters 7-14", [
+      "<4>",
+      "<s>"
+    ], [
+      describe(),
+      describe$1()
+    ]);
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 182, characters 7-14", [
+      "7",
+      [
+        1,
+        1
+      ]
+    ], [
+      packedInt,
+      [
+        1,
+        1
+      ]
+    ]);
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 183, characters 7-14", 3, size({
+      TAG: "Node",
+      _0: {hd: "Leaf", tl: {hd: {
+        TAG: "Node",
+        _0: /* [] */0
+      }, tl: /* [] */0}}
+    }));
+    Test_utils.eq("File \"type_path_lookup_test.res\", line 184, characters 7-14", [
+      2,
+      2
+    ], [
+      branchCount(tree),
+      width({
+        TAG: "Node",
+        _0: {hd: "Leaf", tl: {hd: "Leaf", tl: /* [] */0}}
+      })
+    ]);
+  });
+});
+
+let first = 1;
+
+let second = after;
+
+let Colour;
+
+let Counter$make = make;
+
+export {
+  Inner,
+  first,
+  second,
+  Rec,
+  fromOpen,
+  afterOpen,
+  Shadow,
+  shadowed,
+  unshadowed,
+  Color,
+  Colour,
+  colourName,
+  colorAsColour,
+  Counter,
+  Wrap,
+  IntWrap,
+  StringWrap,
+  wrappedSum,
+  wrappedString,
+  showPacked,
+  packedInt,
+  pair,
+  tree,
+  branchCount,
+  Tree,
+  Forest,
+  Counter$make,
+}
+/* packedInt Not a pure module */
diff --git a/tests/tests/src/type_path_lookup_test.res b/tests/tests/src/type_path_lookup_test.res
new file mode 100644
index 0000000000..687c2eb06e
--- /dev/null
+++ b/tests/tests/src/type_path_lookup_test.res
@@ -0,0 +1,186 @@
+open Mocha
+open Test_utils
+
+// The type checker memoizes type path lookups per request. Each section
+// resolves the same type path text against environments that bind it
+// differently, so a stale lookup would make it fail to type check or change
+// the generated code.
+
+// A type shadowed in a nested module, then used again outside it.
+type t = int
+
+module Inner = {
+  let before: t = 1
+  type t = string
+  let after: t = "two"
+}
+
+let first: t = Inner.before
+let second = Inner.after
+
+// A local open shadows a type, and the outer type is used again afterwards.
+module Rec = {
+  type t = {a: int}
+}
+
+type r = {b: string}
+
+let fromOpen = () => {
+  open Rec
+  let v: t = {a: 3}
+  v.a
+}
+
+let afterOpen = () => {
+  let v: r = {b: "after"}
+  v.b
+}
+
+// A local module shadows a top-level module of the same name.
+module Shadow = {
+  type t = int
+  let v: t = 10
+}
+
+let shadowed = () => {
+  module Shadow = {
+    type t = string
+    let v: t = "shadowed"
+  }
+  Shadow.v ++ "!"
+}
+
+let unshadowed = Shadow.v + 1
+
+// Module aliases: the alias path normalizes to the aliased module's type.
+module Color = {
+  type t = Red | Green
+}
+
+module Colour = Color
+
+let colourName = (c: Colour.t) =>
+  switch c {
+  | Red => "red"
+  | Green => "green"
+  }
+
+let colorAsColour = (c: Color.t): Colour.t => c
+
+// A module type constraint makes a type abstract outside the module.
+module Counter: {
+  type t
+  let make: int => t
+  let get: t => int
+} = {
+  type t = int
+  let make = n => n * 2
+  let get = n => n
+}
+
+// Functor applications give the same type path different meanings.
+module type Value = {
+  type t
+  let value: t
+  let show: t => string
+}
+
+module Wrap = (V: Value) => {
+  type t = V.t
+  let wrapped: t = V.value
+  let describe = () => "<" ++ V.show(wrapped) ++ ">"
+}
+
+module IntWrap = Wrap({
+  type t = int
+  let value = 4
+  let show = n => Int.toString(n)
+})
+
+module StringWrap = Wrap({
+  type t = string
+  let value = "s"
+  let show = s => s
+})
+
+let wrappedSum = IntWrap.wrapped + 1
+let wrappedString = StringWrap.wrapped ++ "!"
+
+// First-class modules and locally abstract types.
+let showPacked = (type a, m: module(Value with type t = a)) => {
+  module M = unpack(m)
+  M.show(M.value)
+}
+
+let packedInt = showPacked(
+  module(
+    {
+      type t = int
+      let value = 7
+      let show = n => Int.toString(n)
+    }
+  ),
+)
+
+let pair = (type a, x: a): array<a> => [x, x]
+
+// A recursive type group is checked with placeholder declarations first,
+// then with the real ones under the same identifiers.
+type rec node<'a> = Leaf('a) | Branch(branches<'a>)
+and branches<'a> = list<node<'a>>
+
+let tree = Branch(list{Leaf(1), Branch(list{})})
+
+let branchCount = (n: node<int>) =>
+  switch n {
+  | Leaf(_) => 0
+  | Branch(b) => List.length(b)
+  }
+
+// Recursive modules refer to each other's types, and are typed against an
+// approximation of their signatures first.
+module rec Tree: {
+  type t = Leaf | Node(Forest.t)
+  let size: t => int
+  let width: t => int
+} = {
+  type t = Leaf | Node(Forest.t)
+
+  let width = t =>
+    switch t {
+    | Leaf => 0
+    | Node(f) => List.length(f)
+    }
+
+  let size = t =>
+    switch t {
+    | Leaf => 1
+    | Node(f) => 1 + Forest.size(f)
+    }
+}
+and Forest: {
+  type t = list<Tree.t>
+  let size: t => int
+} = {
+  type t = list<Tree.t>
+  let size = f => List.reduce(f, 0, (acc, t) => acc + Tree.size(t))
+}
+
+describe(__MODULE__, () => {
+  test("shadowed and opened types", () => {
+    eq(__LOC__, (1, "two"), (first, second))
+    eq(__LOC__, (3, "after"), (fromOpen(), afterOpen()))
+    eq(__LOC__, ("shadowed!", 11), (shadowed(), unshadowed))
+  })
+  test("aliases and constraints", () => {
+    eq(__LOC__, ("red", "green"), (colourName(Red), colourName(colorAsColour(Green))))
+    eq(__LOC__, 6, Counter.get(Counter.make(3)))
+  })
+  test("functors, first-class and recursive modules", () => {
+    eq(__LOC__, (5, "s!"), (wrappedSum, wrappedString))
+    eq(__LOC__, ("<4>", "<s>"), (IntWrap.describe(), StringWrap.describe()))
+    eq(__LOC__, ("7", [1, 1]), (packedInt, pair(1)))
+    eq(__LOC__, 3, Tree.size(Node(list{Leaf, Node(list{})})))
+    eq(__LOC__, (2, 2), (branchCount(tree), Tree.width(Node(list{Leaf, Leaf}))))
+  })
+})