refactor: minimize instantiate diff

Signed-off-by: Antonio Nuno Monteiro <[email protected]>

src/dune_rules/lib.ml

@@ -435,12 +435,7 @@ type db =
   ; resolve_name : Lib_name.t -> resolve_result_with_multiple_results Memo.t
   ; resolve_sentinel : Lib_info.Sentinel.t -> resolve_result Memo.t
   ; instantiate :
-      (Lib_name.t
-       -> Lib_info.Sentinel.t
-       -> Path.t Lib_info.t
-       -> hidden:string option
-       -> Status.t Memo.t)
-        Lazy.t
+      (Lib_name.t -> Path.t Lib_info.t -> hidden:string option -> Status.t Memo.t) Lazy.t
   ; all : Lib_info.Sentinel.t list Memo.Lazy.t
   ; lib_config : Lib_config.t
   ; instrument_with : Lib_name.t list
@@ -904,11 +899,7 @@ module rec Resolve_names : sig
 
   val make_instantiate
     :  db Lazy.t
-    -> (Lib_name.t
-        -> Lib_info.Sentinel.t
-        -> Path.t Lib_info.t
-        -> hidden:string option
-        -> Status.t Memo.t)
+    -> (Lib_name.t -> Path.t Lib_info.t -> hidden:string option -> Status.t Memo.t)
          Staged.t
 end = struct
   open Resolve_names
@@ -925,7 +916,7 @@ end = struct
       >>| Package.Name.Map.of_list_exn)
   ;;
 
-  let instantiate_impl db (name, sentinel, info, hidden) =
+  let instantiate_impl db (name, info, hidden) =
     let db = Lazy.force db in
     let open Memo.O in
     let unique_id = Id.make ~name ~path:(Lib_info.src_dir info) in
@@ -1080,6 +1071,7 @@ end = struct
         let* package = Lib_info.package info in
         Package.Name.Map.find projects_by_package package
     in
+    let sentinel = Lib_info.sentinel info in
     let rec t =
       lazy
         (let open Resolve.O in
@@ -1135,13 +1127,15 @@ end = struct
   ;;
 
   module Input = struct
-    type t = Lib_name.t * Lib_info.Sentinel.t * Path.t Lib_info.t * string option
+    type t = Lib_name.t * Path.t Lib_info.t * string option
 
-    let equal (lib_name, sentinel, _, _) (lib_name', sentinel', _, _) =
+    let equal (lib_name, info, _) (lib_name', info', _) =
+      let sentinel = Lib_info.sentinel info
+      and sentinel' = Lib_info.sentinel info' in
       Lib_name.equal lib_name lib_name' && Lib_info.Sentinel.equal sentinel sentinel'
     ;;
 
-    let hash (x, _, _, _) = Lib_name.hash x
+    let hash (x, _, _) = Lib_name.hash x
     let to_dyn = Dyn.opaque
   end
 
@@ -1150,7 +1144,6 @@ end = struct
       module Rec : sig
         val memo
           :  Lib_name.t
-          -> Lib_info.Sentinel.t
           -> Path.t Lib_info.t
           -> hidden:string option
           -> Status.t Memo.t
@@ -1161,10 +1154,10 @@ end = struct
               "db-instantiate"
               ~input:(module Input)
               (instantiate_impl db)
-              ~human_readable_description:(fun (name, _sentinel, info, _hidden) ->
+              ~human_readable_description:(fun (name, info, _hidden) ->
                 Dep_path.Entry.Lib.pp { name; path = Lib_info.src_dir info })
           in
-          fun name sentinel info ~hidden -> Memo.exec memo (name, sentinel, info, hidden)
+          fun name info ~hidden -> Memo.exec memo (name, info, hidden)
         ;;
       end
     end
@@ -1174,30 +1167,33 @@ end = struct
 
   let instantiate db name info ~hidden = (Lazy.force db.instantiate) name info ~hidden
 
+  let resolve_hidden db ~info hidden =
+    let open Memo.O in
+    (match db.parent with
+     | None -> Memo.return Status.Not_found
+     | Some db ->
+       let sentinel = Lib_info.sentinel info in
+       resolve_sentinel db sentinel)
+    >>= function
+    | Status.Found _ as x -> Memo.return x
+    | _ ->
+      let name = Lib_info.name info in
+      instantiate db name info ~hidden:(Some hidden)
+  ;;
+
   let handle_resolve_result db ~super = function
     | Ignore -> Memo.return Status.Ignore
     | Redirect_in_the_same_db (_, name') -> find_internal db name'
     | Redirect (db', sentinel') -> resolve_sentinel db' sentinel'
     | Found info ->
       let name = Lib_info.name info in
-      let sentinel = Lib_info.sentinel info in
-      instantiate db name sentinel info ~hidden:None
+      instantiate db name info ~hidden:None
     | Invalid e -> Memo.return (Status.Invalid e)
     | Not_found ->
       (match db.parent with
        | None -> Memo.return Status.Not_found
        | Some db -> super db)
-    | Hidden { lib = info; reason = hidden; path = _ } ->
-      let open Memo.O in
-      (match db.parent with
-       | None -> Memo.return Status.Not_found
-       | Some db -> super db)
-      >>= (function
-       | Status.Found _ as x -> Memo.return x
-       | _ ->
-         let name = Lib_info.name info in
-         let sentinel = Lib_info.sentinel info in
-         instantiate db name sentinel info ~hidden:(Some hidden))
+    | Hidden { lib = info; reason = hidden; path = _ } -> resolve_hidden db ~info hidden
   ;;
 
   let handle_resolve_result_with_multiple_results db ~super result =
@@ -1216,32 +1212,21 @@ end = struct
              | Disabled_because_of_enabled_if -> Memo.return None
              | Normal | Optional ->
                let name = Lib_info.name info in
-               let sentinel = Lib_info.sentinel info in
-               instantiate db name sentinel info ~hidden:None >>| Option.some)
+               instantiate db name info ~hidden:None >>| Option.some)
           | Invalid e -> Memo.return (Some (Status.Invalid e))
           | Not_found -> Memo.return None
           | Hidden { lib = info; reason = hidden; path = _ } ->
-            (match db.parent with
-             | None -> Memo.return Status.Not_found
-             | Some db ->
-               let sentinel = Lib_info.sentinel info in
-               resolve_sentinel db sentinel)
-            >>= (function
-             | Status.Found _ as x -> Memo.return (Some x)
-             | _ ->
-               let name = Lib_info.name info
-               and sentinel = Lib_info.sentinel info in
-               instantiate db name sentinel info ~hidden:(Some hidden) >>| Option.some))
+            resolve_hidden db ~info hidden >>| Option.some)
       in
       (match libs with
        | [] -> assert false
        | [ status ] -> status
        | _ :: _ :: _ ->
          List.fold_left libs ~init:Status.Not_found ~f:(fun acc status ->
            match acc, status with
-           | (Status.Found a as lib), Status.Found b ->
+           | Status.Found a, Status.Found b ->
              (match Lib_info.Sentinel.equal a.sentinel b.sentinel with
-              | true -> lib
+              | true -> acc
               | false ->
                 let a = info a
                 and b = info b in