unikernel/duniverse/psq/.gitignore

@@ -0,0 +1,11 @@
+_build
+
+tmp
+*~
+\.\#*
+\#*#
+
+gmon.out
+perf.data*
+rondom
+*.json

unikernel/duniverse/psq/.ocamlinit

@@ -0,0 +1,26 @@
+#require "fmt"
+(* #directory "_build/src" *)
+(* #load "psq.cma" *)
+
+let shuff arr =
+  let n = Array.length arr in
+  for i = 0 to n - 2 do
+    let j = Random.int (n - i) + i in
+    let t = arr.(i) in
+    arr.(i) <- arr.(j);
+    arr.(j) <- t
+  done
+
+let permutation n =
+  let arr = Array.init n (fun x -> x) in
+  shuff arr;
+  Array.to_list arr
+
+let rec (--) a b = if a > b then [] else a :: succ a -- b
+
+module I = struct type t = int let compare = compare end
+module Q = Psq.Make (I) (I)
+
+let pp_q = Q.pp_dump Fmt.int Fmt.int
+;;
+#install_printer pp_q

unikernel/duniverse/psq/.travis.yml

@@ -0,0 +1,15 @@
+language: c
+install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh
+script: bash -ex .travis-opam.sh
+sudo: required
+env:
+  global:
+    - PACKAGE="psq"
+  matrix:
+    - OCAML_VERSION=4.03
+    - OCAML_VERSION=4.04
+    - OCAML_VERSION=4.05
+    - OCAML_VERSION=4.06
+    - OCAML_VERSION=4.07
+notifications:
+  email: false

unikernel/duniverse/psq/CHANGES.md

@@ -0,0 +1,25 @@
+## v0.2.1 2022-10-25
+
+- added `push` to bump priorities
+- added `split_at`
+- changed `++`, `of_list` to select the lowest, not the last/rightmost priority
+
+## v0.2.0 2019-04-09
+
+Semantics cleanup.
+
+- flipped args to `adjust` **breaking**
+- `of_list` now always chooses the rightmost binding
+- `update`, `(++)`, `add_seq`, `to_priority_list`
+- somewhat faster
+
+## v0.1.1 2019-04-06
+
+- `Seq.t` conversions
+- property tests
+- fixed key ordering of interval queries
+- key order tie-breaks `min`
+
+## v0.1.0 2016-11-20
+
+First release. 

unikernel/duniverse/psq/LICENSE.md

@@ -0,0 +1,13 @@
+Copyright (c) 2016 David Kaloper Meršinjak
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

unikernel/duniverse/psq/README.md

@@ -0,0 +1,23 @@
+## psq — Functional Priority Search Queues
+
+v0.2.0-7-gb2eb861
+
+psq provides a functional priority search queue for OCaml. This structure
+behaves both as a finite map, containing bindings `k -> p`, and a priority queue
+over `p`. It provides efficient access along more than one axis: to any binding
+by `k`, and to the binding(s) with the least `p`.
+
+Typical applications are searches, schedulers and caches. If you ever scratched
+your head because that A\* didn't look quite right, a PSQ is what you needed.
+
+The implementation is backed by [priority search pennants][hinze].
+
+psq is distributed under the ISC license.
+
+[hinze]: https://www.cs.ox.ac.uk/ralf.hinze/publications/ICFP01.pdf
+
+## Documentation
+
+Documentation is generated by `odoc`. It can be browsed [online][doc].
+
+[doc]: https://pqwy.github.io/psq/doc/psq/

unikernel/duniverse/psq/dune-project

@@ -0,0 +1,3 @@
+(lang dune 1.7)
+(name psq)
+(version v0.2.0-7-gb2eb861)

unikernel/duniverse/psq/psq.opam

@@ -0,0 +1,25 @@
+version: "0.2.1"
+opam-version: "2.0"
+maintainer: "David Kaloper Meršinjak <dk505@cam.ac.uk>"
+authors: ["David Kaloper Meršinjak <dk505@cam.ac.uk>"]
+homepage: "https://github.com/pqwy/psq"
+doc: "https://pqwy.github.io/psq/doc"
+license: "ISC"
+dev-repo: "git+https://github.com/pqwy/psq.git"
+bug-reports: "https://github.com/pqwy/psq/issues"
+synopsis: "Functional Priority Search Queues"
+build: [ [ "dune" "subst" ] {pinned}
+         [ "dune" "build" "-p" name "-j" jobs ]
+         [ "dune" "runtest" "-p" name ] {with-test & ocaml:version >= "4.07.0"} ]
+depends: [
+  "ocaml" {>="4.03.0"}
+  "dune" {build & >= "1.7"}
+  "seq"
+  "qcheck-core"     {with-test}
+  "qcheck-alcotest" {with-test}
+  "alcotest"        {with-test}
+]
+description: """
+Typical applications are searches, schedulers and caches. If you ever scratched
+your head because that A* didn't look quite right, a PSQ is what you needed.
+"""

unikernel/duniverse/psq/src/dune

@@ -0,0 +1,5 @@
+(library
+  (public_name psq)
+  (synopsis "Functional Priority Search Queues")
+  (libraries seq)
+  (wrapped false))

unikernel/duniverse/psq/src/psq.ml

@@ -0,0 +1,400 @@
+(* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md *)
+
+type 'a fmt = Format.formatter -> 'a -> unit
+
+let pf = Format.fprintf
+
+module type Ordered = sig type t val compare : t -> t -> int end
+
+module type S = sig
+  type t
+  type k
+  type p
+  val empty : t
+  val sg : k -> p -> t
+  val (++) : t -> t -> t
+  val is_empty : t -> bool
+  val size : t -> int
+  val mem : k -> t -> bool
+  val find : k -> t -> p option
+  val add : k -> p -> t -> t
+  val push : k -> p -> t -> t
+  val remove : k -> t -> t
+  val adjust : k -> (p -> p) -> t -> t
+  val update : k -> (p option -> p option) -> t -> t
+  val split_at : k -> t -> t * t
+  val min : t -> (k * p) option
+  val rest : t -> t option
+  val pop : t -> ((k * p) * t) option
+  val fold_at_most : p -> (k -> p -> 'a -> 'a) -> 'a -> t -> 'a
+  val iter_at_most : p -> (k -> p -> unit) -> t -> unit
+  val to_seq_at_most : p -> t -> (k * p) Seq.t
+  val of_list : (k * p) list -> t
+  val of_sorted_list : (k * p) list -> t
+  val of_seq : (k * p) Seq.t -> t
+  val add_seq : (k * p) Seq.t -> t -> t
+  val to_list : t -> (k * p) list
+  val to_seq : t -> (k * p) Seq.t
+  val fold : (k -> p -> 'a -> 'a) -> 'a -> t -> 'a
+  val iter : (k -> p -> unit) -> t -> unit
+  val to_priority_list : t -> (k * p) list
+  val to_priority_seq : t -> (k * p) Seq.t
+  val filter : (k -> p -> bool) -> t -> t
+  val partition : (k -> p -> bool) -> t -> t * t
+  val pp : ?sep:(unit fmt) -> (k * p) fmt -> t fmt
+  val pp_dump : k fmt -> p fmt -> t fmt
+  val depth : t -> int
+end
+
+module Make (K: Ordered) (P: Ordered) :
+  S with type k = K.t and type p = P.t =
+struct
+
+  type k = K.t
+  type p = P.t
+
+  type t = (* SEARCH PENNANTS *)
+    N
+  | T of (k * p) * k * tree
+
+  and tree = (* LOSER TREES, OH MY *)
+    Lf
+  | NdL of (k * p) * tree * k * tree * int
+  | NdR of (k * p) * tree * k * tree * int
+
+  let empty = N
+  let sg (k, _ as kp) = T (kp, k, Lf)
+
+  let is_empty = function N -> true | _ -> false
+
+  let size_t = function
+    Lf -> 0
+  | NdL (_, _, _, _, w)
+  | NdR (_, _, _, _, w) -> w
+
+  let size = function N -> 0 | T (_, _, t) -> size_t t + 1
+
+  let nd_l kp t1 sk t2 = NdL (kp, t1, sk, t2, size_t t1 + size_t t2 + 1)
+  let nd_r kp t1 sk t2 = NdR (kp, t1, sk, t2, size_t t1 + size_t t2 + 1)
+
+  let nd (k, _ as kp) t1 sk t2 =
+    if K.compare k sk <= 0 then nd_l kp t1 sk t2 else nd_r kp t1 sk t2
+
+
+  let outweighs s1 s2 = s1 * 100 > s2 * 375
+
+  let (@<=@) (k1, p1) (k2, p2) =
+    match P.compare p1 p2 with 0 -> K.compare k1 k2 <= 0 | c -> c < 0
+  [@@inline]
+
+  let rot_l kp1 t1 sk1 = function
+    NdL (kp2, t2, sk2, t3, _) when kp1 @<=@ kp2 ->
+      nd kp1 (nd kp2 t1 sk1 t2) sk2 t3
+  | NdL (kp2, t2, sk2, t3, _) | NdR (kp2, t2, sk2, t3, _) ->
+      nd kp2 (nd kp1 t1 sk1 t2) sk2 t3
+  | Lf -> assert false
+
+  let rot_r kp1 tt sk2 t3 = match tt with
+    NdR (kp2, t1, sk1, t2, _) when kp1 @<=@ kp2 ->
+      nd kp1 t1 sk1 (nd kp2 t2 sk2 t3)
+  | NdL (kp2, t1, sk1, t2, _) | NdR (kp2, t1, sk1, t2, _) ->
+      nd kp2 t1 sk1 (nd kp1 t2 sk2 t3)
+  | Lf -> assert false
+
+  let rot_ll kp1 t1 sk1 = function
+    NdL (kp2, t2, sk2, t3, _) | NdR (kp2, t2, sk2, t3, _) ->
+      rot_l kp1 t1 sk1 (rot_r kp2 t2 sk2 t3)
+  | Lf -> assert false
+
+  let rot_rr kp1 tt sk2 t3 = match tt with
+    NdL (kp2, t1, sk1, t2, _) | NdR (kp2, t1, sk1, t2, _) ->
+      rot_r kp1 (rot_l kp2 t1 sk1 t2) sk2 t3
+  | Lf -> assert false
+
+  (* Precond: at most one of t1, t2 is at most 1 away from a balanced
+     configuration. *)
+  let nd_bal kp t1 sk t2 =
+    let s1 = size_t t1 and s2 = size_t t2 in
+    match (t1, t2) with
+      ((NdL (_, t11, _, t12, _) | NdR (_, t11, _, t12, _)), _)
+      when s1 > 1 && outweighs s1 s2 ->
+        if size_t t11 > size_t t12 then
+          rot_r kp t1 sk t2
+        else rot_rr kp t1 sk t2
+    | (_, (NdL (_, t21, _, t22, _) | NdR (_, t21, _, t22, _)))
+      when s2 > 1 && outweighs s2 s1 ->
+        if size_t t21 < size_t t22 then
+          rot_l kp t1 sk t2
+        else rot_ll kp t1 sk t2
+    | _ -> nd kp t1 sk t2
+
+  let (><) t1 t2 = match (t1, t2) with
+    (N, t) | (t, N) -> t
+  | (T (kp1, sk1, t1), T (kp2, sk2, t2)) ->
+      if kp1 @<=@ kp2 then
+        T (kp1, sk2, nd_bal kp2 t1 sk1 t2)
+      else T (kp2, sk2, nd_bal kp1 t1 sk1 t2)
+  [@@inline]
+
+  let (>|<) (k1, _ as kp1) (k2, _ as kp2) =
+    if kp1 @<=@ kp2 then
+      T (kp1, k2, NdR (kp2, Lf, k1, Lf, 1))
+    else T (kp2, k2, NdL (kp1, Lf, k1, Lf, 1))
+  [@@inline]
+
+  let rec promote sk0 = function
+    Lf -> N
+  | NdL (kp, t1, sk, t2, _) -> T (kp, sk, t1) >< promote sk0 t2
+  | NdR (kp, t1, sk, t2, _) -> promote sk t1 >< T (kp, sk0, t2)
+
+  let min = function N -> None | T (kp, _, _) -> Some kp
+  let rest = function N -> None | T (_, sk, t) -> Some (promote sk t)
+  let pop = function N -> None | T (kp, sk, t) -> Some (kp, promote sk t)
+
+  let find k0 t =
+    let rec go k0 = function
+      Lf -> None
+    | NdL ((k, p), t1, sk, t2, _)
+    | NdR ((k, p), t1, sk, t2, _) ->
+        if K.compare k0 k = 0 then Some p else
+          if K.compare k0 sk <= 0 then go k0 t1 else go k0 t2 in
+    match t with
+      N -> None
+    | T ((k, p), _, t) -> if K.compare k0 k = 0 then Some p else go k0 t
+
+  let mem k0 t =
+    let rec go k0 = function
+      Lf -> false
+    | NdL ((k, _), t1, sk, t2, _)
+    | NdR ((k, _), t1, sk, t2, _) ->
+        K.compare k0 k = 0 ||
+        if K.compare k0 sk <= 0 then go k0 t1 else go k0 t2 in
+    match t with N -> false | T ((k, _), _, t) -> K.compare k0 k = 0 || go k0 t
+
+  let foldr_at_most p0 f t z =
+    let rec f1 p0 (_, p as kp) f z t =
+      if P.compare p p0 <= 0 then f2 p0 kp f z t else z ()
+    and f2 p0 kp0 f z = function
+      Lf -> f kp0 z
+    | NdL (kp, t1, _, t2, _) -> f1 p0 kp f (fun () -> f2 p0 kp0 f z t2) t1
+    | NdR (kp, t1, _, t2, _) -> f2 p0 kp0 f (fun () -> f1 p0 kp f z t2) t1 in
+    match t with T (kp0, _, t) -> f1 p0 kp0 f z t | _ -> z ()
+
+  let fold_at_most p0 f z t =
+    foldr_at_most p0 (fun (k, p) a -> f k p (a ())) t (fun () -> z)
+
+  let iter_at_most p0 f t =
+    foldr_at_most p0 (fun (k, p) i -> f k p; i ()) t ignore
+
+  let to_seq_at_most p0 t () =
+    foldr_at_most p0 (fun kp seq -> Seq.Cons (kp, seq)) t Seq.empty
+
+  (* type view = Nv | Sgv of (k * p) | Binv of t * K.t * t *)
+
+  (* let view = function *)
+  (*   N -> Nv *)
+  (* | T (kp, _, Lf) -> Sgv kp *)
+  (* | T (kp1, sk1, NdL (kp2, t1, sk2, t2, _)) -> *)
+  (*     Binv (T (kp2, sk2, t1), sk2, T (kp1, sk1, t2)) *)
+  (* | T (kp1, sk1, NdR (kp2, t1, sk2, t2, _)) -> *)
+  (*     Binv (T (kp1, sk2, t1), sk2, T (kp2, sk1, t2)) *)
+
+  (* let rec add (k0, _ as kp0) t = match view t with *)
+  (*   | Nv -> sg kp0 *)
+  (*   | Sgv (k, _) -> *)
+  (*       let c = K.compare k0 k and t' = sg kp0 in *)
+  (*       if c < 0 then t' >< t else if c > 0 then t >< t' else t' *)
+  (*   | Binv (t1, sk, t2) -> *)
+  (*       if K.compare k0 sk <= 0 then add kp0 t1 >< t2 else t1 >< add kp0 t2 *)
+
+  (* let remove k0 t = *)
+  (*   let rec go k0 t = match view t with *)
+  (*     Binv (t1, sk, t2) -> *)
+  (*       if K.compare k0 sk <= 0 then go k0 t1 >< t2 else t1 >< go k0 t2 *)
+  (*   | Sgv (k, _) when K.compare k k0 = 0 -> N *)
+  (*   | Sgv _ | Nv -> raise_notrace Exit in *)
+  (*   try go k0 t with Exit -> t *)
+
+  (* let adjust k0 f t = *)
+  (*   let rec go f k0 t = match view t with *)
+  (*     Binv (t1, sk, t2) -> *)
+  (*       if K.compare k0 sk <= 0 then go f k0 t1 >|< t2 else t1 >|< go f k0 t2 *)
+  (*   | Sgv (k, p) when K.compare k k0 = 0 -> sg (k, f p) *)
+  (*   | Sgv _ | Nv -> raise_notrace Exit in *)
+  (*   try go f k0 t with Exit -> t *)
+
+  (* let rec filter pf t = match view t with *)
+  (*   Nv -> N *)
+  (* | Sgv (k, p as kp) -> if pf k p then sg kp else N *)
+  (* | Binv (t1, _, t2) -> filter pf t1 >< filter pf t2 *)
+
+  let update =
+    let rec go k0 f (k1, p1 as kp1) sk1 = function
+      Lf ->
+        let c = K.compare k0 k1 in
+        if c = 0 then
+          match f (Some p1) with
+          | Some p when p == p1 -> raise_notrace Exit
+          | Some p -> sg (k0, p)
+          | None -> N
+        else ( match f None with
+          | Some p when c < 0 -> (k0, p) >|< kp1
+          | Some p -> kp1 >|< (k0, p)
+          | None -> raise_notrace Exit )
+    | NdL (kp2, t1, sk2, t2, _) ->
+        if K.compare k0 sk2 <= 0 then
+          go k0 f kp2 sk2 t1 >< T (kp1, sk1, t2)
+        else T (kp2, sk2, t1) >< go k0 f kp1 sk1 t2
+    | NdR (kp2, t1, sk2, t2, _) ->
+        if K.compare k0 sk2 <= 0 then
+          go k0 f kp1 sk2 t1 >< T (kp2, sk1, t2)
+        else T (kp1, sk2, t1) >< go k0 f kp2 sk1 t2 in
+    fun k0 f -> function
+    | N -> (match f None with Some p -> sg (k0, p) | _ -> N)
+    | T (kp, sk, t1) as t -> try go k0 f kp sk t1 with Exit -> t
+
+  let add k p t = update k (fun _ -> Some p) t
+  let push k p t = update k (function
+    | Some p0 -> Some (if P.compare p p0 < 0 then p else p0)
+    | None -> Some p) t
+  let remove k t = update k (fun _ -> None) t
+  let adjust k f t = update k (function Some p -> Some (f p) | _ -> None) t
+
+  let filter =
+    let rec go pf kp1 sk1 = function
+      Lf -> if pf (fst kp1) (snd kp1) then sg kp1 else N
+    | NdL (kp2, t1, sk2, t2, _) -> go pf kp2 sk2 t1 >< go pf kp1 sk1 t2
+    | NdR (kp2, t1, sk2, t2, _) -> go pf kp1 sk2 t1 >< go pf kp2 sk1 t2 in
+    fun pf -> function N -> N | T (kp, sk, t) -> go pf kp sk t
+
+  let partition pf t = filter pf t, filter (fun k p -> not (pf k p)) t
+
+  let split_at =
+    let rec go k0 pk sk = function
+    | Lf -> if K.compare (fst pk) k0 <= 0 then sg pk, empty else empty, sg pk
+    | NdL (pk1, t1, sk1, t2, _) ->
+        if K.compare k0 sk1 <= 0 then
+          let t11, t12 = go k0 pk1 sk1 t1 in t11, t12 >< T (pk, sk, t2)
+        else let t21, t22 = go k0 pk sk t2 in T (pk1, sk1, t1) >< t21, t22
+    | NdR (pk1, t1, sk1, t2, _) ->
+        if K.compare k0 sk1 <= 0 then
+          let t11, t12 = go k0 pk sk1 t1 in t11, t12 >< T (pk1, sk, t2)
+        else let t21, t22 = go k0 pk1 sk t2 in T (pk, sk1, t1) >< t21, t22 in
+    fun k0 -> function N -> N, N | T (pk, sk, t) -> go k0 pk sk t
+
+  let rec (++) =
+    let app q1 = function
+    | N -> q1
+    | T ((k, p), _, Lf) -> push k p q1
+    | T ((k1, p1), _,
+         (NdL ((k2, p2), Lf, _, Lf, _) |
+          NdR ((k2, p2), Lf, _, Lf, _))) -> push k1 p1 (push k2 p2 q1)
+    | T (kp, sk, NdL (kp1, t1, sk1, t2, _)) ->
+        let q11, q12 = split_at sk1 q1 in
+        (q11 ++ T (kp1, sk1, t1)) >< (q12 ++ T (kp, sk, t2))
+    | T (kp, sk, NdR (kp1, t1, sk1, t2, _)) ->
+        let q11, q12 = split_at sk1 q1 in
+        (q11 ++ T (kp, sk1, t1)) >< (q12 ++ T (kp1, sk, t2)) in
+    fun q1 q2 -> if size q1 < size q2 then app q2 q1 else app q1 q2
+
+  let of_sorted_list =
+    let rec group1 = function
+    | [] -> []
+    | [x] -> [sg x]
+    | [x;y] -> [x >|< y]
+    | [x;y;z] -> [(x >|< y) >< sg z]
+    | x::y::z::w::xs -> ((x >|< y) >< (z >|< w)) :: group1 xs
+    and group2 = function
+    | [] | [_] as r -> r
+    | [x;y] -> [x >< y]
+    | [x;y;z] -> [(x >< y) >< z]
+    | x::y::z::w::xs -> ((x >< y) >< (z >< w)) :: group2 xs
+    and go = function [] -> N | [t] -> t | ts -> go (group2 ts) in
+    fun xs -> go (group1 xs)
+
+  let of_list =
+    let rec sieve k0 a = function
+    | [] -> a
+    | (k, _) as kv :: kvs ->
+        if K.compare k0 k = 0 then sieve k0 a kvs else sieve k (kv :: a) kvs in
+    let cmp_kv (k1, p1) (k2, p2) =
+      match K.compare k2 k1 with 0 -> P.compare p1 p2 | r -> r in
+    fun xs -> match List.sort cmp_kv xs with
+    | [] -> empty
+    | (k, _) as kv :: kvs -> sieve k [kv] kvs |> of_sorted_list
+
+  let of_seq xs = Seq.fold_left (fun xs a -> a::xs) [] xs |> of_list
+
+  let add_seq xs q = Seq.fold_left (fun q (k, p) -> add k p q) q xs
+
+  let iter =
+    let rec go (p0, k0 as pk0) f = function
+      Lf -> f p0 k0
+    | NdL (pk, t1, _, t2, _) -> go pk f t1; go pk0 f t2
+    | NdR (pk, t1, _, t2, _) -> go pk0 f t1; go pk f t2 in
+    fun f -> function N -> () | T (pk, _, t) -> go pk f t
+
+  let foldr =
+    let rec go kp0 f z = function
+      Lf -> f kp0 z
+    | NdL (kp, t1, _, t2, _) -> go kp f (go kp0 f z t2) t1
+    | NdR (kp, t1, _, t2, _) -> go kp0 f (go kp f z t2) t1 in
+    fun f z -> function N -> z | T (kp, _, t) -> go kp f z t
+
+  let lfoldr =
+    let rec go kp0 f z = function
+      Lf -> f kp0 z
+    | NdL (kp, t1, _, t2, _) -> go kp f (fun () -> go kp0 f z t2) t1
+    | NdR (kp, t1, _, t2, _) -> go kp0 f (fun () -> go kp f z t2) t1 in
+    fun f z -> function T (kp, _, t) -> go kp f z t | N -> z ()
+
+  let fold f z t = foldr (fun (k, p) z -> f k p z) z t
+  let to_list t = foldr (fun kp xs -> kp :: xs) [] t
+  let to_seq t () = lfoldr (fun kp xs -> Seq.Cons (kp, xs)) Seq.empty t
+
+  let to_priority_list =
+    let rec (--) xs ys = match xs, ys with
+      [], l | l, [] -> l
+    | x::xt, y::yt -> if x @<=@ y then x :: (xt -- ys) else y :: (xs -- yt) in
+    let rec go = function
+      Lf -> []
+    | NdL (kp2, t1, _, t2, _) -> (kp2 :: go t1) -- go t2
+    | NdR (kp2, t1, _, t2, _) -> go t1 -- (kp2 :: go t2) in
+    function N -> [] | T (kp, _, t) -> kp :: go t
+
+  let to_priority_seq t () =
+    let open Seq in
+    let rec (--) n1 n2 = match n1, n2 with
+      Nil, n | n, Nil -> n
+    | Cons (x, xt), Cons (y, yt) ->
+        if x @<=@ y then
+          Cons (x, fun _ -> xt () -- n2)
+        else Cons (y, fun _ -> n1 -- yt ()) in
+    let rec go = function
+      Lf -> Nil
+    | NdL (kp2, t1, _, t2, _) -> Cons (kp2, fun _ -> go t1) -- go t2
+    | NdR (kp2, t1, _, t2, _) -> go t1 -- Cons (kp2, fun _ -> go t2) in
+    match t with N -> Nil | T (kp, _, t) -> Cons (kp, fun _ -> go t)
+
+  let sg k p = sg (k, p)
+
+  let depth t =
+    let rec go = function
+      Lf -> 0
+    | NdL (_, t1, _, t2, _) | NdR (_, t1, _, t2, _) ->
+        max (go t1) (go t2) + 1 in
+    match t with N -> 0 | T (_, _, t) -> go t + 1
+
+  let pp ?(sep = Format.pp_print_space) pp ppf t =
+    let first = ref true in
+    let k ppf = iter @@ fun k p ->
+      ( match !first with true -> first := false | _ -> sep ppf ());
+      pp ppf (k, p) in
+    pf ppf "@[%a@]" k t
+
+  let pp_dump ppk ppp ppf =
+    let sep ppf () = pf ppf ";@ "
+    and ppkp ppf (k, p) = pf ppf "(@[%a,@ %a@])" ppk k ppp p in
+    pf ppf "of_sorted_list [%a]" (pp ~sep ppkp)
+end

unikernel/duniverse/psq/src/psq.mli

@@ -0,0 +1,223 @@
+(* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md *)
+
+(** Functional Priority Search Queues
+
+    [Psq] provides a functional structure that behaves as both a finite map and
+    a priority queue.
+
+    {ul
+    {- The structure contains a collection of bindings [k -> p], and allows
+       efficient {{!S.add}addition}, {{!S.find}lookup} and {{!S.remove}removal}
+       of bindings by key.}
+    {- It additionally supports {{!S.min}access} to, and {{!S.rest}removal} of
+       the binding [k -> p] with the least [p].}}
+
+    The implementation is backed by a weight-balanced semi-heap. Access by key
+    is [O(log n)]. Access to the minimal [p] is [O(1)], and its removal is
+    [O(log n)].
+
+    {b References}
+    {ul
+    {- Ralf Hinze.
+    {{:https://www.cs.ox.ac.uk/ralf.hinze/publications/ICFP01.pdf} A Simple
+    Implementation Technique for Priority Search Queues}. 2001.}}
+
+    {e v0.2.0-7-gb2eb861 — {{:https://github.com/pqwy/psq }homepage}} *)
+
+(** {1 Psq} *)
+
+(** Signature of priority search queues. *)
+module type S = sig
+
+  (** {1 Priority Search Queue} *)
+
+  type t
+  (** A search queue. *)
+
+  type k
+  (** Keys in {{!t}[t]}. *)
+
+  type p
+  (** Priorities in {{!t}[t]}. *)
+
+  val empty : t
+  (** [empty] is the search queue that contains no bindings. *)
+
+  val sg : k -> p -> t
+  (** [sg k p] is the singleton search queue, containing only the
+      binding [k -> p]. *)
+
+  val (++) : t -> t -> t
+  (** [t1 ++ t2] contains bindings from [t1] and [t2]. If a key [k] is bound in
+      both, the result has the binding with lower priority.
+
+      Hence,
+      {ul
+      {- [t1 ++ t2 = t2 ++ t1]}
+      {- [(t1 ++ t2) ++ t3 = t1 ++ (t2 ++ t3)]}} *)
+
+  val is_empty : t -> bool
+  (** [is_empty t] is [true] iff [t] is {{!empty}[empty]}. *)
+
+  val size : t -> int
+  (** [size t] is the number of distinct bindings in [t]. *)
+
+  (** {1 Access by [k]} *)
+
+  val mem : k -> t -> bool
+  (** [find k t] is [true] iff [k] is bound in [t]. *)
+
+  val find : k -> t -> p option
+  (** [find k t] is [Some p] if [t] contains the binding [k -> p], or [None]
+      otherwise. *)
+
+  val add : k -> p -> t -> t
+  (** [add k p t] is [t] with the binding [k -> p].
+
+      Note that [add] does {e not} commute:
+      [add k p2 (add k p1 q) <> add k p1 (add k p2 q)] when [p1 <> p2].
+      Compare {!push}. *)
+
+  val push : k -> p -> t -> t
+  (** [push k p t] is [t] with [k] bound to the lower of [p] and its previous
+      priority in [t], if it exists — when [t] contains [k -> p0], the result
+      contains [k -> min p0 p], otherwise it contains [k -> p].
+
+      Note that [push] commutes:
+      [push k p1 (push k p2 q) = push k p2 (push k p1 q)]. Compare {!add}. *)
+
+  val remove : k -> t -> t
+  (** [remove k t] is [t] without any bindings for [k]. *)
+
+  val adjust : k -> (p -> p) -> t -> t
+  (** [adjust k f t] is [t] with the binding [k -> p] replaced by [k -> f p].
+      When [k] is not bound in [t], the result is [t]. *)
+
+  val update : k -> (p option -> p option) -> t -> t
+  (** [update k f t] is [t] with the binding for [k] given by [f].
+
+      When [t] contains a binding [k -> p], the new binding is given by
+      [f (Some p)]; otherwise, by [f None].
+
+      When the result of applying [f] is [Some p'], the binding [k -> p'] is
+      added to [t]; otherwise, the binding for [k] is removed from [t]. *)
+
+  val split_at : k -> t -> t * t
+  (** [split_at k t] splits [t] into [(t0, t1)], such that for all keys [k0] in
+      [t0], [k0 <= k], for all keys [k1] in [t1], [k1 > k], and [t = t0 ++ t1].  *)
+
+  (** {1 Access by min [p]} *)
+
+  val min : t -> (k * p) option
+  (** [min t] is the binding [Some (k, p)] where [p] is minimal in [t], or
+      [None] if [t] is {{!empty}[empty]}.
+
+      When several keys share the minimal priority, [min t] is the binding with
+      the smallest key. *)
+
+  val rest : t -> t option
+  (** [rest t] is [t] without the binding [min t], or [None]. *)
+
+  val pop : t -> ((k * p) * t) option
+  (** [pop t] is [(min t, rest t)], or [None]. *)
+
+  val fold_at_most : p -> (k -> p -> 'a -> 'a) -> 'a -> t -> 'a
+  (** [fold_at_most p0 f z q] folds [f] over bindings [k -> p] where [p] is not
+      larger than [p0], in key-ascending order. *)
+
+  val iter_at_most : p -> (k -> p -> unit) -> t -> unit
+  (** [iter_at_most p0 f q] applies [f] to the bindings [k -> p] where [p] is
+      not larger than [p0], in key-ascending order. *)
+
+  val to_seq_at_most : p -> t -> (k * p) Seq.t
+  (** [iter_at_most p0 f q] is the sequence of bindings [k -> p] where [p] not
+      larger than [p0], in key-ascending order. *)
+
+  (** {1 Aggregate construction} *)
+
+  val of_list : (k * p) list -> t
+  (** [of_list kps] is [t] with bindings [kps].
+
+      When [pks] contains multiple priorities for a given [k], the lowest one
+      wins. *)
+
+  val of_sorted_list : (k * p) list -> t
+  (** [of_sorted_list kps] is [t] with bindings [kps].
+      [kps] must contain the bindings in key-ascending order without
+      repetitions. When this is not the case, the result is undefined.
+
+      {b Note} When applicable, this operation is faster than
+      {{!of_list}[of_list]}. *)
+
+  val of_seq : (k * p) Seq.t -> t
+  (** [of_seq kps] is [of_list (List.of_seq kps)]. *)
+
+  val add_seq : (k * p) Seq.t -> t -> t
+  (** [of_seq kps t] is [t ++ of_seq kps]. *)
+
+  (** {1 Whole-structure access} *)
+
+  val to_list : t -> (k * p) list
+  (** [to_list t] are all the bindings in [t] in key-ascending order. *)
+
+  val to_seq : t -> (k * p) Seq.t
+  (** [to_seq t] iterates over bindings in [t] in key-ascending order. *)
+
+  val fold : (k -> p -> 'a -> 'a) -> 'a -> t -> 'a
+  (** [fold f z t] is [f k0 p0 (f k1 p1 ... (f kn pn z))], where
+      [k0, k1, ..., kn] are in ascending order. *)
+
+  val iter : (k -> p -> unit) -> t -> unit
+  (** [iter f t] applies [f] to all bindings in [t] in key-ascending order. *)
+
+  val to_priority_list : t -> (k * p) list
+  (** [to_priority_list t] are the bindings in [t] in priority-ascending order.
+
+      {b Note} Priority-ordered traversal is slower than key-ordered traversal. *)
+
+  val to_priority_seq : t -> (k * p) Seq.t
+  (** [to_priority_seq t] is the sequence version of [to_priority_list].
+
+      {b Note} For traversing the whole [t], [to_priority_list] is more
+      efficient. *)
+
+  val filter : (k -> p -> bool) -> t -> t
+  (** [filter p t] is the search queue with exactly the bindings in [t] which
+      satisfy the predicate [p]. *)
+
+  val partition : (k -> p -> bool) -> t -> t * t
+  (** [partition p t] is [(filter p t, filter np t)] where [np] is the negation
+      of [p]. *)
+
+  (** {1 Pretty-printing} *)
+
+  open Format
+
+  val pp : ?sep:(formatter -> unit -> unit) -> (formatter -> k * p -> unit) ->
+           formatter -> t -> unit
+  (** [pp ?sep pp_kp ppf t] pretty-prints [t] to [ppf], using [pp_kp] to print
+      the bindings and [~sep] to separate them.
+
+      [~sep] defaults to {!Format.print_space}. *)
+
+  val pp_dump : (formatter -> k -> unit) -> (formatter -> p -> unit) ->
+                formatter -> t -> unit
+  (** [pp_dump pp_k pp_f ppf t] is a handier pretty-printer for development. *)
+
+  (**/**)
+  (* Debug. *)
+  val depth : t -> int
+  (**/**)
+end
+
+(** Signature of ordered types. *)
+module type Ordered = sig
+  type t
+  val compare : t -> t -> int
+  (** [compare] is a total order on {{!t}[t]}. *)
+end
+
+(** [Make(K)(P)] is the {{!S}priority search queue} with bindings [K.t -> P.t]. *)
+module Make (K: Ordered) (P: Ordered):
+  S with type k = K.t and type p = P.t

unikernel/duniverse/psq/test/bench.ml

@@ -0,0 +1,86 @@
+(* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md *)
+
+let shuffle arr =
+  let n = Array.length arr in
+  for i = 0 to n - 2 do
+    let j = Random.int (n - i) + i in
+    let t = arr.(i) in
+    arr.(i) <- arr.(j); arr.(j) <- t
+  done
+
+let permutation n =
+  let arr = Array.init n (fun x -> x) in
+  shuffle arr;
+  Array.to_list arr
+
+let r_bindings n = permutation n |> List.rev_map (fun x -> x, x)
+
+module type S = sig
+  type t
+  val add     : int -> int -> t -> t
+  val find    : int -> t -> int option
+  val remove  : int -> t -> t
+  val of_list : (int * int) list -> t
+end
+module I = struct type t = int let compare (a: int) b = compare a b end
+module Q = Psq.Make (I)(I)
+let q = (module Q: S)
+let m = (module struct
+  module M = Map.Make (I)
+  type t = int M.t
+  let find, add, remove = M.(find_opt, add, remove)
+  let of_list xs = List.fold_left (fun m (k, v) -> M.add k v m) M.empty xs
+end: S)
+
+open Unmark
+
+let runs ((module M: S)) size =
+  let xs = r_bindings size in
+  let q  = M.of_list xs
+  and q' = List.rev_map (fun (k, p) -> (k * 2, p * 2)) xs |> M.of_list in
+  group (Fmt.strf "x%d" size) [
+    bench "find" (fun () -> M.find (Random.int size) q)
+  ; bench "add" (fun () -> let k = Random.int size + 1 in M.add k k q')
+  ; bench "remove" (fun () -> M.remove (Random.int size) q)
+  ]
+
+let runs1 size =
+  let xs = r_bindings size in
+  let q = Q.of_list xs in
+  group (Fmt.strf "x%d" size) [
+    group "of_" [
+      bench "of_sorted_list" (fun () -> Q.of_sorted_list xs)
+    ; bench "of_list" (fun () -> Q.of_list xs)
+    ; bench "of_seq" (fun () -> Q.of_seq (List.to_seq xs))
+    ; bench "add_seq" (fun () -> Q.(add_seq (List.to_seq xs) empty))
+    ];
+    group "to_" [
+      bench "to_p_list" (fun () -> Q.to_priority_list q)
+    ; bench "to_seq" (fun () -> Q.to_seq q |> Seq.iter ignore)
+    ; bench "to_list" (fun () -> Q.to_list q)
+    ]
+  ]
+
+let runs2 size =
+  let r_key () = Random.int (size * 5) in
+  let gen n = List.init n Random.(fun _ -> r_key (), int n) |> Q.of_list in
+  let xs, ys, zs = gen size, gen size, gen 10 in
+  group (Fmt.strf "x%d" size) [
+    bench "split" (fun () -> Q.split_at (r_key ()) xs);
+    bench "filter" (fun () ->
+      let x = r_key () in Q.filter (fun k _ -> k <= x) xs);
+    bench "++" (fun () -> Q.(xs ++ ys));
+    bench "++ k" (fun () -> Q.(xs ++ zs));
+  ]
+
+
+let arg = Cmdliner.Arg.(
+  value @@ opt (list int) [10; 100; 1000] @@ info ["sizes"])
+let _ = Unmark_cli.main_ext "psq" ~arg @@ fun ns -> [
+    bench "Random.int" (fun () -> Random.int 1000)
+  ; group "map" (List.map (runs m) ns)
+  ; group "psq" (List.map (runs q) ns)
+  ; group "psq1" (List.map runs1 ns)
+  ; group "psq2" (List.map runs2 ns)
+]

unikernel/duniverse/psq/test/dune

@@ -0,0 +1,14 @@
+(test
+  (name test)
+  (modules test)
+  (libraries psq alcotest qcheck-core qcheck-alcotest))
+
+(executable
+  (name bench)
+  (modules bench)
+  (libraries psq unmark unmark.cli))
+
+(executable
+  (name search)
+  (modules search)
+  (libraries psq fmt))

unikernel/duniverse/psq/test/search.ml

@@ -0,0 +1,55 @@
+(* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md *)
+
+let rec mem ?(cmp=compare) a = function
+  | [] -> false | x::xs -> cmp a x = 0 || mem ~cmp a xs
+
+let rec add ?(cmp=compare) a = function
+  | []    -> [a]
+  | x::xs ->
+      match cmp a x with -1 -> a::x::xs | 1 -> x::add ~cmp a xs | _ -> x::xs
+
+let astar (type a) ?(cmp=compare) start graph h sat =
+  let module K = struct type t = a let compare = cmp end in
+  let module P = struct
+    type t = int * a list
+    let compare (a: t) b = compare (fst a) (fst b)
+  end in
+  let module Q = Psq.Make(K)(P) in
+  let rec go q = match Q.pop q with
+    | Some ((a, (dist, path)), q) ->
+        if sat a then Some (dist, a, List.rev path) else
+          let f q (w, b) =
+            let d' = w + h b in
+            if mem ~cmp b path then q else
+              match Q.find b q with
+              | Some (d, _) when d <= d' -> q
+              | _ -> Q.add b (d', a::path) q in
+          go @@ List.fold_left f q @@ graph a
+    | None -> None in
+  go Q.(sg start (0, []))
+
+let labyrinth p0 (pn_m, pn_n as pn) grid =
+  let (m0, n0) = Array.(length grid, length grid.(0)) in
+  let h (m, n) = abs (pn_m - m) + abs (pn_n - n)
+  and sat mn = mn = pn
+  and graph (m, n) =
+    (if m > 0    && grid.(m-1).(n) = `o then [1, (m-1, n)] else []) @
+    (if m < m0-1 && grid.(m+1).(n) = `o then [1, (m+1, n)] else []) @
+    (if n > 0    && grid.(m).(n-1) = `o then [1, (m, n-1)] else []) @
+    (if n < n0-1 && grid.(m).(n+1) = `o then [1, (m, n+1)] else []) in
+  match astar ~cmp:compare p0 graph h sat with
+  | None -> Fmt.pr "not found\n%!"
+  | Some (dist, (m, n), path) ->
+      Fmt.(pr "@[(%d, %d), dist: %d@;steps: %a@]\n%!"
+        m n dist (Dump.(list (pair int int))) path)
+
+let l : [`X|`o] array array =
+[|[| `o; `X; `o; `o; `o; `o; |];
+  [| `o; `X; `X; `X; `o; `o; |];
+  [| `o; `o; `o; `o; `X; `o; |];
+  [| `o; `X; `X; `X; `o; `o; |];
+  [| `o; `X; `o; `o; `o; `o; |];
+  [| `o; `o; `o; `X; `X; `o; |]|]
+
+let () = labyrinth (0, 0) (5, 5) l

unikernel/duniverse/psq/test/test.ml

@@ -0,0 +1,201 @@
+(* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md *)
+
+let id x = x
+let (%) f g x = f (g x)
+
+module I = struct type t = int let compare (a: int) b = compare a b end
+module Q = Psq.Make (I) (I)
+
+let list_of_iter_2 i =
+  let xs = ref [] in i (fun a b -> xs := (a, b) :: !xs); List.rev !xs
+let rec unfold f s = match f s with Some (x, s) -> x :: unfold f s | _ -> []
+
+let cmpi (a: int) b = compare a b
+let (%%) f g a b = f (g a) (g b)
+let (=>) cmp1 cmp2 a b = match cmp1 a b with 0 -> cmp2 a b | r -> r
+let k_order xs = List.sort (cmpi %% fst) xs
+let pk_order xs = List.sort (cmpi %% snd => cmpi %% fst) xs
+let k_order_uniq xs =
+  let cmp_kp = cmpi %% fst => cmpi %% snd and cmp_k = cmpi %% fst in
+  match List.sort_uniq cmp_kp xs with
+  | [] -> []
+  | kp0::kps ->
+      let f kp xs kp0 = if cmp_k kp kp0 = 0 then xs kp0 else kp :: xs kp in
+      kp0 :: List.fold_right f kps (fun _ -> []) kp0
+
+let is_balanced q =
+  let (n, d) = Q.(size q, depth q) in
+  n <= 1 || float d < log (float n) *. log 10. *. 3.75
+
+let (!) q = `Sem (Q.to_list q)
+let sem xs = `Sem (k_order_uniq xs)
+
+let g_size = QCheck.Gen.(small_nat >|= fun x -> x mod 1_000)
+let bindings = QCheck.(
+  make Gen.(list_size g_size (pair small_nat small_nat))
+    ~print:Fmt.(to_to_string Dump.(pair int int |> list))
+    ~shrink:Shrink.list)
+let psq = QCheck.(
+  map Q.of_list bindings ~rev:Q.to_list |>
+    set_print Fmt.(to_to_string (Q.pp_dump int int)))
+let kv = QCheck.small_nat
+let psq_w arb = QCheck.pair psq arb
+let psq_w_any_key = psq_w kv
+
+let test name gen p =
+  QCheck.Test.make ~count:200 ~name gen p |> QCheck_alcotest.to_alcotest
+
+let () = Alcotest.run "psq" [
+
+  "of_list", [
+    test "sem" bindings (fun xs -> !(Q.of_list xs) = sem xs);
+    test "of_sorted_list sem" bindings
+      (fun xs -> !(Q.of_sorted_list (k_order_uniq xs)) = sem xs);
+    test "bal" bindings (fun xs -> is_balanced (Q.of_list xs));
+  ];
+
+  "to_list", [
+    test "order" psq (fun q -> Q.to_list q = k_order (Q.to_list q));
+  ];
+
+  "to_priority_list", [
+    test "sem" psq (fun q -> Q.to_priority_list q = pk_order (Q.to_list q))
+  ];
+
+  "size", [
+    test "sem" psq (fun q -> Q.size q = List.length (Q.to_list q));
+  ];
+
+  "sg", [
+    test "sem" kv (fun x -> !Q.(sg x x) = sem [x, x]);
+  ];
+
+  "(++)", [
+    test "sem" QCheck.(pair bindings bindings)
+      (fun (xs1, xs2) -> !Q.(of_list xs1 ++ of_list xs2) = sem (xs1 @ xs2));
+    test "comm" QCheck.(pair psq psq)
+      (fun (q1, q2) -> !Q.(q1 ++ q2) = !Q.(q2 ++ q1));
+    test "assoc" QCheck.(pair psq psq |> pair psq)
+      (fun (q1, (q2, q3)) -> !Q.((q1 ++ q2) ++ q3) = !Q.(q1 ++ (q2 ++ q3)));
+  ];
+
+  "split_at", [
+    test "sem" psq_w_any_key (fun (q, k) ->
+      let q1, q2 = Q.split_at k q
+      and xs1, xs2 = List.partition (fun (k1, _) -> k1 <= k) (Q.to_list q) in
+      !q1 = sem xs1 && !q2 = sem xs2);
+    test "inv" psq_w_any_key (fun (q, k) ->
+      let q1, q2 = Q.split_at k q in !q = !Q.(q1 ++ q2));
+  ];
+
+  "membership", [
+    test "find sem" psq_w_any_key
+      (fun (q, x) -> Q.find x q = List.assoc_opt x (Q.to_list q));
+    test "mem ==> find" psq_w_any_key
+      (fun (q, k) -> QCheck.assume Q.(mem k q); Q.find k q <> None);
+    test "find ==> mem" psq_w_any_key
+      (fun (q, k) -> QCheck.assume (Q.find k q <> None); Q.mem k q);
+  ];
+
+  "update", [
+    test "sem" (psq_w QCheck.(pair kv (option kv)))
+      (fun (q, (x, yy)) ->
+        let kp = match yy with Some y -> [x, y] | _ -> [] in
+        !(Q.update x (fun _ -> yy) q) =
+          sem (kp @ List.remove_assoc x (Q.to_list q)));
+    test "bal" (psq_w QCheck.(pair kv (option kv)))
+      (fun (q, (x, yy)) -> is_balanced (Q.update x (fun _ -> yy) q));
+    test "phys" psq_w_any_key (fun (q, x) -> Q.update x id q == q);
+  ];
+
+  "add", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        !(Q.add x x q) = sem ((x, x) :: List.remove_assoc x (Q.to_list q)));
+    test "bal" psq_w_any_key (fun (q, k) -> is_balanced (Q.add k k q));
+  ];
+
+  "push", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        let p = match List.assoc_opt x (Q.to_list q) with
+        | Some p0 -> min x p0
+        | None -> x in
+        !(Q.push x x q) = sem ((x, p) :: List.remove_assoc x (Q.to_list q)));
+    test "mono" psq_w_any_key
+       (fun (q, x) ->
+         QCheck.assume (Q.mem x q);
+         Q.find x (Q.push x x q) <= Q.find x q);
+    test "comm" (psq_w (QCheck.pair kv kv))
+      (fun (q, (x, y)) ->
+        !Q.(q |> push x x |> push x y) = !Q.(q |> push x y |> push x x));
+    test "= of_list" bindings
+      (fun xs ->
+        !(Q.of_list xs) =
+          !(List.fold_left (fun q (k, p) -> Q.push k p q) Q.empty xs));
+  ];
+
+  "remove", [
+    test "sem" psq_w_any_key
+      (fun (q, k) ->
+        !(Q.remove k q) = sem (List.remove_assoc k (Q.to_list q)));
+    test "phys" psq_w_any_key
+      (fun (q, k) -> QCheck.assume (not (Q.mem k q)); Q.remove k q == q);
+    test "bal" psq_w_any_key (fun (q, k) -> Q.(remove k q |> is_balanced));
+  ];
+
+  "adjust", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        !(Q.adjust x succ q) =
+          sem (Q.to_list q |>
+            List.map (fun (k, p) -> (k, if k = x then succ p else p))));
+  ];
+
+  "pop", [
+    test "sem1" psq (fun q -> unfold Q.pop q = pk_order (Q.to_list q));
+    test "sem2" psq (fun q -> unfold Q.pop q = Q.to_priority_list q);
+    test "min, rest" psq
+      (fun q ->
+        QCheck.assume (not (Q.is_empty q));
+        match Q.(pop q, min q, rest q) with
+          Some (kp1, q1), Some kp2, Some q2 -> kp1 = kp2 && !q1 = !q2
+        | _ -> false);
+  ];
+
+  "at_most", [
+    test "sem" psq_w_any_key
+      (fun (q, x) ->
+        List.of_seq (Q.to_seq_at_most x q) =
+          List.filter (fun kp -> snd kp <= x) (Q.to_list q));
+    test "seq = fold" psq_w_any_key
+      (fun (q, x) ->
+        List.of_seq (Q.to_seq_at_most x q) =
+          Q.fold_at_most x (fun k p xs -> (k, p)::xs) [] q);
+    test "seq = iter" psq_w_any_key
+      (fun (q, x) ->
+        List.of_seq (Q.to_seq_at_most x q) =
+          list_of_iter_2 (fun f -> Q.iter_at_most x f q));
+  ];
+
+  "to_stuff", [
+    test "to_list = to_seq" psq
+      (fun q -> Q.to_list q = (Q.to_seq q |> List.of_seq));
+    test "to_list = fold" psq
+      (fun q -> Q.to_list q = Q.fold (fun k p xs -> (k, p) :: xs) [] q);
+    test "to_list = iter" psq
+      (fun q -> Q.to_list q = list_of_iter_2 (fun f -> Q.iter f q));
+    test "to_priority_seq" psq
+      (fun q -> Q.to_priority_list q = List.of_seq (Q.to_priority_seq q));
+  ];
+
+  "filter", [
+    test "sem" psq_w_any_key
+      (fun (q, k0) ->
+        !(Q.filter (fun k _ -> k <= k0) q) =
+          sem (List.filter (fun (k, _) -> k <= k0) (Q.to_list q)));
+    test "bal" psq_w_any_key
+      (fun (q, k0) -> is_balanced (Q.filter (fun k _ -> k <= k0) q));
+  ];
+]