From e10736ab17c8d8dfaefc455090af808d5e504d49 Mon Sep 17 00:00:00 2001 From: Jason Evans Date: Sat, 4 Jul 2026 21:27:45 -0700 Subject: [PATCH 1/3] Fix a doc comment --- bootstrap/bin/hocc/workq.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bootstrap/bin/hocc/workq.mli b/bootstrap/bin/hocc/workq.mli index 280c325b8..1aee267e2 100644 --- a/bootstrap/bin/hocc/workq.mli +++ b/bootstrap/bin/hocc/workq.mli @@ -29,7 +29,7 @@ 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]. From 3362b7f23e69fc8e60761f593a6908d01f17ecc4 Mon Sep 17 00:00:00 2001 From: Jason Evans Date: Sat, 4 Jul 2026 21:27:14 -0700 Subject: [PATCH 2/3] Use `Ordmap` rather than `Deq` to implement `Workq` `Deq` uses non-tail-recursive algorithms that can overflow the execution stack for large queues. Use an `i64`-keyed `Ordmap` instead. --- bootstrap/bin/hocc/workq.ml | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/bootstrap/bin/hocc/workq.ml b/bootstrap/bin/hocc/workq.ml index cb2119940..4e25de0bb 100644 --- a/bootstrap/bin/hocc/workq.ml +++ b/bootstrap/bin/hocc/workq.ml @@ -3,7 +3,7 @@ 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; } @@ -13,12 +13,12 @@ type ('a, 'cmp) cmper = (module Cmper.SMono with type t = 'a and type cmper_witn let m_cmper (type k cmp) ((module M) : (k, cmp) cmper) = M.cmper -let pp {cmper; deq; _} = - Deq.pp cmper.pp deq +let pp {cmper; q; _} = + Ordmap.pp cmper.pp q let empty m = { cmper=m_cmper m; - deq=Deq.empty; + q=Ordmap.empty (module I64); set=Set.empty m; } @@ -28,26 +28,41 @@ let length {set; _} = let is_empty {set; _} = Set.is_empty set -let push elm {cmper; deq; set} = +let push elm {cmper; 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 {cmper; 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 {cmper; 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, {cmper; q=q'; set=set'} let mem elm {set; _} = Set.mem elm set From 7def348b48868c6357a2c337868a9b9553f6e9a0 Mon Sep 17 00:00:00 2001 From: Jason Evans Date: Sat, 4 Jul 2026 21:28:19 -0700 Subject: [PATCH 3/3] Remove unused `Workq` functionality --- bootstrap/bin/hocc/workq.ml | 22 ++++------------------ bootstrap/bin/hocc/workq.mli | 6 ------ 2 files changed, 4 insertions(+), 24 deletions(-) diff --git a/bootstrap/bin/hocc/workq.ml b/bootstrap/bin/hocc/workq.ml index 4e25de0bb..146b7b097 100644 --- a/bootstrap/bin/hocc/workq.ml +++ b/bootstrap/bin/hocc/workq.ml @@ -2,22 +2,13 @@ open Basis open! Basis.Rudiments type ('a, 'cmp) t = { - cmper: ('a, 'cmp) Cmper.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; q; _} = - Ordmap.pp cmper.pp q - let empty m = { - cmper=m_cmper m; q=Ordmap.empty (module I64); set=Set.empty m; } @@ -28,7 +19,7 @@ let length {set; _} = let is_empty {set; _} = Set.is_empty set -let push elm {cmper; q; set} = +let push elm {q; set} = assert (not (Set.mem elm set)); let k = match Ordmap.length q with | 0L -> I64.zero @@ -38,12 +29,11 @@ let push elm {cmper; q; set} = end in { - cmper; q=Ordmap.insert_hlt ~k ~v:elm q; set=Set.insert elm set; } -let push_back elm {cmper; q; set} = +let push_back elm {q; set} = assert (not (Set.mem elm set)); let k = match Ordmap.length q with | 0L -> I64.zero @@ -53,19 +43,15 @@ let push_back elm {cmper; q; set} = end in { - cmper; q=Ordmap.insert_hlt ~k ~v:elm q; set=Set.insert elm set; } -let pop {cmper; q; set} = +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; q=q'; set=set'} + elm, {q=q'; set=set'} let mem elm {set; _} = Set.mem elm set - -let set {set; _} = - set diff --git a/bootstrap/bin/hocc/workq.mli b/bootstrap/bin/hocc/workq.mli index 1aee267e2..4f4620097 100644 --- a/bootstrap/bin/hocc/workq.mli +++ b/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. *) @@ -37,6 +34,3 @@ val pop: ('a, 'cmp) t -> 'a * ('a, 'cmp) 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]. *)