Workq

bootstrap/bin/hocc/workq.ml

@@ -2,23 +2,14 @@ open Basis
 open! Basis.Rudiments
 
 type ('a, 'cmp) t = {
-  cmper: ('a, 'cmp) Cmper.t;
-  deq: 'a Deq.t;
+  q: (i64, 'a, I64.cmper_witness) Ordmap.t;
   set: ('a, 'cmp) Set.t;
 }
 
 type ('a, 'cmp) cmper = (module Cmper.SMono with type t = 'a and type cmper_witness = 'cmp)
 
-(* Extract cmper from first-class module compatible with Cmper.SMono. *)
-let m_cmper (type k cmp) ((module M) : (k, cmp) cmper) =
-  M.cmper
-
-let pp {cmper; deq; _} =
-  Deq.pp cmper.pp deq
-
 let empty m = {
-  cmper=m_cmper m;
-  deq=Deq.empty;
+  q=Ordmap.empty (module I64);
   set=Set.empty m;
 }
 
@@ -28,29 +19,39 @@ let length {set; _} =
 let is_empty {set; _} =
   Set.is_empty set
 
-let push elm {cmper; deq; set} =
+let push elm {q; set} =
   assert (not (Set.mem elm set));
+  let k = match Ordmap.length q with
+    | 0L -> I64.zero
+    | _ -> begin
+        let kmin, _elm = Ordmap.nth 0L q in
+        I64.pred kmin
+      end
+  in
   {
-    cmper;
-    deq=Deq.push elm deq;
+    q=Ordmap.insert_hlt ~k ~v:elm q;
     set=Set.insert elm set;
   }
 
-let push_back elm {cmper; deq; set} =
+let push_back elm {q; set} =
   assert (not (Set.mem elm set));
+  let k = match Ordmap.length q with
+    | 0L -> I64.zero
+    | l -> begin
+        let kmax, _elm = Ordmap.nth (pred l) q in
+        I64.succ kmax
+      end
+  in
   {
-    cmper;
-    deq=Deq.push_back elm deq;
+    q=Ordmap.insert_hlt ~k ~v:elm q;
     set=Set.insert elm set;
   }
 
-let pop {cmper; deq; set} =
-  let elm, deq' = Deq.pop deq in
+let pop {q; set} =
+  let k, elm = Ordmap.nth 0L q in
+  let q' = Ordmap.remove_hlt k q in
   let set' = Set.remove elm set in
-  elm, {cmper; deq=deq'; set=set'}
+  elm, {q=q'; set=set'}
 
 let mem elm {set; _} =
   Set.mem elm set
-
-let set {set; _} =
-  set

bootstrap/bin/hocc/workq.mli

@@ -13,9 +13,6 @@ type ('a, 'cmp) t
 
 type ('a, 'cmp) cmper = (module Cmper.SMono with type t = 'a and type cmper_witness = 'cmp)
 
-val pp: ('a, 'cmp) t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
-(** [pp t formatter] applies a formatted representation of [t] to the [formatter]. *)
-
 val empty: ('a, 'cmp) cmper -> ('a, 'cmp) t
 (** [empty cmper] returns an empty work queue. *)
 
@@ -29,14 +26,11 @@ val push: 'a -> ('a, 'cmp) t -> ('a, 'cmp) t
 (** [push a t] prepends [a]. [a] must not be present in [t] prior to [push]. *)
 
 val push_back: 'a -> ('a, 'cmp) t -> ('a, 'cmp) t
-(** [push a t] appends [a]. [a] must not be present in [t] prior to [push_back]. *)
+(** [push_back a t] appends [a]. [a] must not be present in [t] prior to [push_back]. *)
 
 val pop: ('a, 'cmp) t -> 'a * ('a, 'cmp) t
 (** [pop t] removes the front element from [t] and returns the element along with the depleted [t].
 *)
 
 val mem: 'a -> ('a, 'cmp) t -> bool
 (** [mem a t] returns true iff [a] is present in [t]. *)
-
-val set: ('a, 'cmp) t -> ('a, 'cmp) Set.t
-(** [set t] returns the set of elements in [t]. *)