Small API cleanup.

bin/dowsindex/CmdSearch.ml

@@ -17,9 +17,9 @@ let main opts =
  error @@ Fmt.str "cannot open index file `%a'" Fpath.pp opts.idx_file
  in
  let res =
- let find = if opts.exhaustive then Db.find_exhaustive else Db.find in
+ let filter = if opts.exhaustive then `None else `Default in
  let iter_idx =
- try find idx env opts.ty ?pkgs
+ try Db.find ~filter idx env opts.ty ?pkgs
  with Not_found -> error "unknown package"
  in
  iter_idx

lib/db/Content.ml

@@ -8,6 +8,7 @@ module ID : sig
  val get : key -> 'a t -> 'a
  val add : 'a -> 'a t -> key
  val iteri : (key -> 'a -> unit) -> 'a t -> unit
+ val size : _ t -> int
  end
  module Set : CCSet.S with type elt = t
 end = struct
@@ -22,6 +23,7 @@ end = struct
  CCVector.push t v;
  CCVector.size t - 1
  let iteri = CCVector.iteri
+ let size = CCVector.size
  end
  module Set = CCSet.Make(CCInt)
 end
@@ -40,6 +42,8 @@ let create () = {
  index_by_lid = LongIdent.HMap.create 17 ;
 }
 
+let size t = ID.Tbl.size t.entries
+
 let find t id =
  ID.Tbl.get id t.entries
 

lib/db/Db.ml

@@ -7,6 +7,11 @@ module TypeIndex = TypeIndex
 
 module DefaultIndex = TypeIndex.Make (Content.ID)
 
+module Logs = (val Logs.(src_log @@ Src.create __MODULE__))
+
+let _info = Logs.info
+let _debug = Logs.debug
+
 type t = {
  idx : DefaultIndex.t ;
  content : Content.t ;
@@ -19,24 +24,19 @@ let create ~with_poset env entries =
  let _ = Content.add content entry in
  ()
  ) entries;
- let type_column =
- Content.iteri content
- |> Iter.map
- (fun (id, entry) -> id, Type.of_outcometree env entry.Entry.ty)
- in
- DefaultIndex.import idx type_column;
+ _info (fun m ->
+ m "@[%i @ types to insert in the index @]"
+ (Content.size content));
+ Content.iteri content
+ |> Iter.map
+ (fun (id, entry) -> id, Type.of_outcometree env entry.Entry.ty)
+ |> Iter.iter
+ (fun (id, ty) -> DefaultIndex.add idx id ty)
+ ;
  { idx; content}
 
-let find ?pkgs t env ty =
- DefaultIndex.find t.idx env ty
- |> Content.resolve_all ?pkgs t.content
-
-let find_with_trie ?pkgs t env ty =
- DefaultIndex.find_with_trie t.idx env ty
- |> Content.resolve_all ?pkgs t.content
-
-let find_exhaustive ?pkgs t env ty =
- DefaultIndex.find_exhaustive t.idx env ty
+let find ?pkgs ?filter t env ty =
+ DefaultIndex.find ?filter t.idx env ty
  |> Content.resolve_all ?pkgs t.content
 
 let iter ?pkgs t =

lib/db/Db.mli

@@ -18,16 +18,7 @@ val create :
 
 val find : 
  ?pkgs:Utils.String.HMap.key list ->
- t ->
- Type.Env.t ->
- Type.t -> (Entry.t * (Type.t * Common.Subst.t)) Iter.t
-val find_with_trie : 
- ?pkgs:Utils.String.HMap.key list ->
- t ->
- Type.Env.t ->
- Type.t -> (Entry.t * (Type.t * Common.Subst.t)) Iter.t
-val find_exhaustive : 
- ?pkgs:Utils.String.HMap.key list ->
+ ?filter:[ `Default | `None | `OnlyTrie] ->
  t ->
  Type.Env.t ->
  Type.t -> (Entry.t * (Type.t * Common.Subst.t)) Iter.t

lib/db/TypeIndex.ml

@@ -1,4 +1,3 @@
-
 module type S = TypeIndexIntf.S
 
 module Logs = (val Logs.(src_log @@ Src.create __MODULE__))
@@ -30,7 +29,8 @@ module Make (I : Set.OrderedType) = struct
 
  let size t = Type.HMap.length t.index_by_type
 
- let add t (entry, ty) =
+ let add t entry ty =
+ _info (fun m -> m "@[Inserting %a @]" Type.pp ty);
  match Type.HMap.get t.index_by_type ty with
  | None ->
  let id = size t in
@@ -48,12 +48,6 @@ module Make (I : Set.OrderedType) = struct
  let entries = ID.Set.add entry entries in
  Type.HMap.replace t.index_by_type ty (entries, tyid)
 
- let import t l =
- _info (fun m ->
- m "@[%i @ types to insert in the index @]"
- (Iter.length l));
- Iter.iter (add t) l
-
  (** Iterators *)
 
  let insert_ids ~to_type t it k =
@@ -90,7 +84,7 @@ module Make (I : Set.OrderedType) = struct
  |> filter_with_unification env ty
  |> insert_ids t ~to_type:fst
 
- let find t env ty : iter_with_unifier =
+ let find_default t env ty : iter_with_unifier =
  match t.poset with
  | None ->
  find_with_trie t env ty
@@ -99,6 +93,12 @@ module Make (I : Set.OrderedType) = struct
  Poset.check poset env ~query:ty ~range
  |> insert_ids t ~to_type:fst
 
+ let find ?(filter=`Default) t env ty : iter_with_unifier =
+ match filter with
+ | `Default -> find_default t env ty
+ | `None -> find_exhaustive t env ty
+ | `OnlyTrie -> find_with_trie t env ty
+
  let pp_metrics fmt t =
  Fmt.pf fmt
  "@[<v>Entries: %i@,\

lib/db/TypeIndexIntf.ml

@@ -18,15 +18,12 @@ module type S = sig
  val create :
  with_poset:bool -> Type.Env.t -> t
 
- val import :
+ val add :
  t ->
- (ID.t * Type.t) Iter.t ->
+ ID.t -> Type.t ->
  unit
- (** [import infos l] adds all the package in [l] to the index [t].
- A package is a triplet [pkg, pkg_dir, iter] where [iter] is an
- iterator of items to index.
-
- Removes old contents from packages if present.
+ (** [add index id ty] adds the association [ty -> id] to the index
+ [index].
  *)
 
  val iter : t -> iter
@@ -36,19 +33,15 @@ module type S = sig
  (** [iter_compatible t ty] iterates over all types whose features 
  are compatible with [ty]. *)
 
- val find : t -> Type.Env.t -> Type.t -> iter_with_unifier
- (** [find t env ty] returns all types which unifies with [ty],
- using the various filtering methods (Trie + Poset).
- *)
-
- val find_with_trie : t -> Type.Env.t -> Type.t -> iter_with_unifier
- (** [find t env ty] returns all types which unifies with [ty],
- using only the Trie filtering.
- *)
-
- val find_exhaustive : t -> Type.Env.t -> Type.t -> iter_with_unifier
- (** [find_exhaustive t env ty] returns all types which unifies with [ty]
- through exhaustive search over all types.
+ val find :
+ ?filter:[ `Default | `None | `OnlyTrie] ->
+ t -> Type.Env.t -> Type.t -> iter_with_unifier
+ (** [find t env ty] returns all types which unifies with [ty].
+ 
+ Use [filter] to select a filtering techniques:
+ - [`Default] uses the most efficient techniques.
+ - [`None] relies on exhaustive search without filters.
+ - [`OnlyTrie] only relies on the Trie index.
  *)
 
  type serial