Build the path of a component found through an open with its binding

Why:
    Id_tbl.find_opened returned the binding and its position as a new
    pair, which find_name and find_all took apart again to build the
    path, so every lookup of a name found in the components of an open
    allocated three words more than before the open tables took the
    cells. In stress/RefsInLoop
    that moved each statement's allocations from 46272 to 46368 bytes, a
    Fibonacci number: with the minor heap the benchmarks run with, the
    objects of the 300 statements in the .cmt then fall on the same slot of
    the marshaller's position table (Fibonacci hashing of addresses, linear
    probing), and marshalling the .cmt took about 40M more instructions
    (+23% under cachegrind), though the file is byte-identical.

find_opened now gives the path and the binding, built from the pair stored
in the table; update, which only Env.copy_types calls, looks the binding up
as before. The bindings found, their order and the outputs are unchanged.

Measured with scripts/compilerBenchmarks.js against the previous commit:
allocated words -0.02% in total, stress/NestedClosures -0.13%, and
stress/RefsInLoop -5.4K words; with perf stat (s=64M as the benchmarks
run) RefsInLoop takes 456.5M instructions, against 515.0M before and 456.1M
for #9192 head.

Review: Does the instruction count of RefsInLoop now depend on luck? Yes,
as before #9194: any change of 96 bytes per statement in this benchmark
can land on a stride that hashes badly, without any work in the compiler.
The fix removes the allocation that moved it there, which is worth having
on its own.

Signed-off-by: Jono Prest <jjprest@gmail.com>

Author: JonoPrest

compiler/ml/env.ml

@@ -298,15 +298,16 @@ module Id_tbl = struct
           (Opened {using; root; components; force; overrides = Tbl.empty; next});
     }
 
-  (* The binding named [name] in an open, with its position. *)
-  let find_opened (type a) name (Opened o : a opened) : a * int =
+  (* The path and binding named [name] in an open. The result is built here,
+     so that a lookup allocates no other pair on the way. *)
+  let find_opened (type a) name (Opened o : a opened) : Path.t * a =
     match Tbl.find_str name o.overrides with
-    | found -> found
+    | desc, pos -> (Pdot (o.root, name, pos), desc)
     | exception Not_found ->
       let desc, pos = Tbl.find_str name o.components in
-      (o.force desc, pos)
+      (Pdot (o.root, name, pos), o.force desc)
 
-  (* Every binding of an open, as [find_opened] gives it. *)
+  (* Every binding of an open, as [find_opened] gives it, with its position. *)
   let fold_opened (type a) f (Opened o : a opened) acc =
     Tbl.fold
       (fun name (desc, pos) acc ->
@@ -328,10 +329,9 @@ module Id_tbl = struct
       (Pident id, desc)
     with Not_found as exn -> (
       match tbl.opened with
-      | Some (Opened {using; root; next} as opened) -> (
+      | Some (Opened {using; next} as opened) -> (
         try
-          let descr, pos = find_opened name opened in
-          let res = (Pdot (root, name, pos), descr) in
+          let res = find_opened name opened in
           (if mark then
              match using with
              | None -> ()
@@ -351,8 +351,14 @@ module Id_tbl = struct
       {tbl with current = Ident.add id new_desc tbl.current}
     with Not_found -> (
       match tbl.opened with
-      | Some (Opened o as opened) -> (
-        match find_opened name opened with
+      | Some (Opened o) -> (
+        match
+          match Tbl.find_str name o.overrides with
+          | found -> found
+          | exception Not_found ->
+            let desc, pos = Tbl.find_str name o.components in
+            (o.force desc, pos)
+        with
         | desc, pos ->
           let overrides = Tbl.add name (f desc, pos) o.overrides in
           {tbl with opened = Some (Opened {o with overrides})}
@@ -368,9 +374,9 @@ module Id_tbl = struct
     @
     match tbl.opened with
     | None -> []
-    | Some (Opened {root; next} as opened) -> (
+    | Some (Opened {next} as opened) -> (
       match find_opened name opened with
-      | desc, pos -> (Pdot (root, name, pos), desc) :: find_all name next
+      | found -> found :: find_all name next
       | exception Not_found -> find_all name next)
 
   let rec fold_name f tbl acc =