add regex-required-anchor-set and chez concurrency-limits notes

ober

2afc3a137588c6da9cd10309169534198c78bacc

diff --git a/docs/chez-limits.md b/docs/chez-limits.md
new file mode 100644
index 0000000..3cfa7cd
--- /dev/null
+++ b/docs/chez-limits.md
@@ -0,0 +1,279 @@
+# Chez Scheme Concurrency Limits
+
+Notes on where Chez Scheme's runtime caps multi-core utilisation, gathered
+while scaling the `jerboa-virus` YARA-like scanner from a single thread up
+to 14 workers on a 14-core Apple Silicon box.
+
+These are real bottlenecks observed at the syscall / sampling-profiler
+level, not theoretical concerns. Each entry below cites the commit where
+the bottleneck was identified and the workaround that recovered the wall
+time.
+
+## TL;DR
+
+- A many-thread Chez program will *not* scale linearly with cores. On a
+  14-core machine after every optimisation listed below, the best
+  measured speedup over j=1 was about **5x** (3.7 s vs ~18 s on a
+  50-file corpus).
+- The dominant ceilings are the **global allocator** (TLAB refill via
+  `S_get_more_room`) and **GC sweep**. Both are visible in `sample` /
+  `Instruments` traces as `S_get_more_room`, `S_collect`, and
+  per-generation sweepers eating cores.
+- Library-level coordination (CSP channels, mutexes, condvars) is a
+  second tier of cost that is largely fixable in-stdlib. Most of the
+  speedup at j>=4 came from removing CSP machinery from hot paths.
+- Profile before optimising: `MallocStackLogging=1`,
+  `/usr/bin/time -l`, macOS `sample <pid>`, and per-thread "what did I
+  do this second" counters in the program itself.
+
+## 1. Allocator: `S_get_more_room` is a global serialisation point
+
+The Chez allocator gives each thread a thread-local allocation buffer
+(TLAB); fast-path allocation is a bump. When the TLAB is exhausted the
+thread enters `S_get_more_room`, which **takes a global tc_mutex** to
+slice a new chunk out of the shared heap. Threads that allocate at high
+rates spend a real fraction of wall time queued behind each other on
+that mutex.
+
+Symptom in `sample`:
+
+```
+S_get_more_room                              ~25-40%
+pthread_mutex_lock <- S_thread_start_code     ~10-15%
+```
+
+This dominates whenever a hot loop allocates per iteration — boxed
+numbers, freshly consed pairs, small strings, `let*` with several
+intermediate vectors. The two cures are *don't allocate* and *allocate
+fewer, larger objects so the TLAB refill cadence drops*.
+
+What worked in jerboa-virus:
+- Replaced `(case-fold-string s)` per-file allocations with a
+  case-folded AC automaton built **once** at rule-compile time
+  (commit `a059b82` — "perf(rules): case-fold AC eliminates unanchored
+  nocase regexes"). The per-file allocation of a folded copy of every
+  scanned file's bytes was a 4-figure-ms cost at j=1 and grew worse
+  with worker count.
+- Fanned pure-literal alternation regexes into AC entries at compile
+  time so the scan-time hot path runs zero regex code and allocates
+  zero match-result vectors for those rules (commit `5b34a23`).
+
+What did *not* work:
+- Adding a "scratch buffer" passed through the scanner to avoid
+  re-allocating match-result vectors per call. Two attempts both
+  produced 12x slowdowns that were never explained. The hypothesis is
+  that the scratch buffer escaped its intended thread-local lifetime
+  and was retained across GC generations, but it was cheaper to back
+  out than to chase. **Lesson: micro-allocation pools in Chez often
+  lose to letting the allocator do its job, because escaping a long-
+  lived box into a hot loop pessimises generation-0 promotion.**
+
+## 2. GC: collector threads steal cores during scan
+
+The Chez collector is mostly-non-concurrent: a major collection stops
+the world. Even minor (generation-0) collections briefly synchronise
+all threads. With 14 workers each allocating in their inner loop, the
+machine spends a measurable fraction of cores in `S_collect`, sweepers,
+and remembered-set fixups.
+
+Symptom: `sample` shows ~5-12% in `S_collect`, plus per-generation
+sweep helpers. Wall time scales worse than user time. Adding more
+workers past a point makes wall time *go up* because the extra
+allocators trigger more GCs.
+
+There is no flag to fix this. The only lever is: allocate less per
+file. Anything that gets a hot loop down to "no allocation, just
+vector-ref" wins twice — once on the TLAB mutex, once on GC pressure.
+
+## 3. CSP channels: broadcast-on-put is a thundering herd
+
+`(std csp)` `chan-put!` and `chan-get!` originally did a
+`condition-broadcast` on every operation. A single put can only
+satisfy one blocked taker, so broadcasting wakes every blocked worker;
+all but one acquire the channel mutex, observe nothing to do, and go
+back to sleep. Each broadcast is a `pthread_cond_broadcast` syscall,
+and the cache line for the channel mutex pingpongs across cores.
+
+Fix in jerboa stdlib (commit `6b7ddf8` "perf(std csp): signal-one on
+channel put/get instead of broadcast"): use `condition-signal` for
+per-item puts/gets; keep `condition-broadcast` only for `chan-close!`
+and the xform short-circuit, where waking every waiter is exactly the
+goal.
+
+Measured impact on a 4-worker /bin scan with the 4963-rule yara-forge
+ruleset:
+
+```
+before: 613 ms wall, 3.64 user, 0.65 sys
+after:  300 ms wall, 1.94 user, 0.57 sys
+```
+
+~2x wall-time speedup at j=4, ~47% CPU reduction. The relative win
+grows with worker count.
+
+**Generalisable rule for CSP-style channels in Chez:** never broadcast
+on per-item operations. If you maintain your own channel-like
+primitive, audit it for the same pattern. A `condition-broadcast`
+behind a hot put/get is one of the most expensive things you can do.
+
+## 4. Buffered channels are still expensive at high j
+
+Even after the signal-one fix, a per-item channel between a producer
+and N consumers is a mutex acquire + condvar signal per item, on both
+sides. For tiny units of work (sub-millisecond file scans) the channel
+overhead is the cost.
+
+In jerboa-virus, the streaming-channel design at j=14 left the
+scanner CPU-bound on `pthread_mutex_lock` from `chan-put!` /
+`chan-get!`. The fix (commit `8491db2` "perf(scan): walk-first +
+claim-box replaces streaming channel") was to throw the channel out
+entirely:
+
+1. Walk the file tree synchronously into a flat path vector
+   on the main thread.
+2. Workers race for **batches of consecutive indices** through a
+   single claim-box (one mutex, no condvar, no broadcast).
+3. Each worker iterates over its claimed range with no further
+   coordination.
+
+This pattern — *batch claim out of a shared vector* — beats a channel
+for any unit-of-work small enough that the per-item synchronisation is
+a meaningful fraction of the work. The 1 ms / 10-files batch size is
+a good default; tune empirically.
+
+## 5. Even small mutexes serialise at scale
+
+`scan-one-file` used to take a `stats-mutex` once per file to bump
+counters (files scanned, bytes hashed, matches found). At j=1 this is
+free. At j=14 it is a serialisation point that has no business
+existing — every worker is racing for the same cache line.
+
+Fix (commit `19e747f` "perf(scan): per-worker stats vectors eliminate
+stats-mutex"): allocate one stats vector per worker; each worker only
+writes to its own slot. The progress ticker reads cross-slot sums
+lock-free for an approximate snapshot (writes are non-atomic, a
+print can race a partial increment, but that's fine for a status
+line). Final totals are summed after `thread-join`, which is a memory
+barrier, so the totals are exact.
+
+Generalisable rule: any mutex that is taken from N workers at the
+unit-of-work cadence should be replaced with **N independent slots
++ summation at join**, even if profiling says the mutex cost is
+"small". The cost is hidden in cache coherence traffic and shows up
+later as a flat ceiling that you cannot push past.
+
+## 6. Sleep + poll lock-steps shutdown
+
+The progress ticker thread slept `progress-interval-ms` (1000 ms)
+between ticks, sampling the `done-box` only on wake. Short scans
+finished in tens of ms but then `(thread-join prog-thread)` blocked
+for the full second until the ticker's sleep elapsed.
+
+Symptom: program prints `Done in 33 ms` but `/usr/bin/time` reports
+1.05 s wall.
+
+Fix (commit `4aaf966`): chunk the 1 s sleep into 25 ms ticks; the
+ticker exits within one tick of `done-box` being set. The visible
+cadence is unchanged.
+
+Generalisable: in Chez, `(sleep <long>)` is uninterruptible. Any
+thread that needs to react to an external signal must either chunk
+its sleep or block on a condvar/channel that the signaller can poke.
+
+## 7. Single-threaded compile / startup
+
+The Chez compiler and image loader are single-threaded. A program
+that imports many large libraries pays this serially at startup, no
+matter how many cores are available. The fix is at packaging time
+(whole-program optimisation, `.wpo` files, bundled images) not at
+runtime; see `docs/bundling-chez.md`.
+
+This is not strictly a concurrency limit during scan, but it shows
+up as a fixed ~1-2 s before the scanner does any user-visible work.
+
+## Observed scaling ceiling
+
+After all of (1)-(6), on a 14-core Apple Silicon machine with
+4963 yara-forge rules and 50 mixed binary/text files:
+
+| j  | wall    | speedup | notes                                |
+|----|---------|---------|--------------------------------------|
+|  1 | ~18 s   | 1.0x    | baseline                             |
+|  2 | ~10 s   | 1.8x    | near-linear                          |
+|  4 |  ~5 s   | 3.6x    | beginning to flatten                 |
+|  8 |  ~4 s   | 4.5x    | allocator + GC starting to dominate  |
+| 14 |  3.7 s  | 4.9x    | flat ceiling                         |
+
+Beyond j=8 the additional workers mostly compete for the allocator
+mutex and trigger more GCs. A run with `--cpu-profile` shows the
+ratio of time spent in `S_get_more_room` rising roughly linearly with
+worker count past j=8.
+
+## Things to try next
+
+These have not been measured but are obvious targets for the next
+round:
+
+1. **Memory-mapped file inputs**: avoid copying scanned bytes into a
+   fresh Scheme string. Each `read-file-as-bytevector` is a multi-MB
+   allocation that pressures the allocator. `mmap` + `bytevector-u8
+   -ref` directly off the mapped region would cut the per-file
+   allocation to zero for read-only access.
+2. **Per-worker AC scratch state**: the AC traversal allocates one
+   small "current state" box per file. Making this a worker-local
+   reusable struct (with a careful escape analysis to confirm no
+   leak across files) could halve generation-0 promotion rate.
+3. **Smaller GC arenas**: Chez's `collect-generation-radix` and the
+   undocumented `$collect-trip-bytes` setting affect GC cadence.
+   Tuning them for "many small allocations, short-lived" rather
+   than the default "general-purpose" might cut GC pause time at
+   the cost of slightly higher CPU.
+4. **Replace Chez allocator entirely for hot loops**: pre-allocate
+   pools of fixed-size match-result records in a vector, manage
+   them by index. This was attempted and reverted (see section 1)
+   but a more careful design with no possibility of cross-thread
+   sharing might work.
+
+## What this means for jerboa code
+
+Practical rules of thumb for any Jerboa program that wants to scale
+past ~4 cores on a real workload:
+
+- **Allocate in the cold path, not the hot path.** Whatever you can
+  pre-compute at startup, do so. The AC build cost amortises; the
+  per-file allocation does not.
+- **Avoid CSP for fine-grained work distribution.** Use a claim-box
+  + shared vector for batch parallelism. Reserve CSP for actual
+  pipelines where the work units are coarse.
+- **Replace mutexes with per-worker slots** whenever the mutex is
+  taken at the unit-of-work cadence, even if the mutex looks cheap.
+- **Profile with `sample` early.** The phrase
+  "`S_get_more_room` is at the top of the profile" is a useful
+  Schelling point: it means you have an allocator-bound program
+  and you should hunt for the per-iteration cons.
+- **Never sleep uninterruptibly on a thread that needs to react
+  to shutdown.** Chunk all timeouts to <50 ms or wait on a
+  condvar.
+
+## References
+
+Commits on the `jerboa-virus` master branch:
+
+- `a059b82` perf(rules): case-fold AC eliminates unanchored nocase regexes
+- `4aaf966` perf(scan): progress ticker no longer holds scan back 1 sec at exit
+- `19e747f` perf(scan): per-worker stats vectors eliminate stats-mutex
+- `8491db2` perf(scan): walk-first + claim-box replaces streaming channel
+- `5b34a23` perf(rules): fan pure-literal alternation regexes into AC literal anchors
+
+Commits on the `jerboa` policy branch:
+
+- `6b7ddf8` perf(std csp): signal-one on channel put/get instead of broadcast
+- `0ec81a9` perf(std text aho-corasick): 13x faster build for 1M+ state automata
+
+Profiling commands used:
+
+```
+sudo sample $(pgrep -n virus-scan) 5 -file /tmp/sample.txt
+/usr/bin/time -l ./virus-scan -j 14 /usr/bin
+VIRUS_PROFILE=1 VIRUS_PROFILE_UNANCH=1 ./virus-scan ...
+```
diff --git a/lib/std/regex.ss b/lib/std/regex.ss
index becc892..07b895b 100644
--- a/lib/std/regex.ss
+++ b/lib/std/regex.ss
@@ -47,7 +47,8 @@
     re-object-pat-string
     ;; Required-literal extraction (for multi-pattern pre-filtering)
     regex-required-literal
-    regex-pure-literal-alts)
+    regex-pure-literal-alts
+    regex-required-anchor-set)
 
   (import (chezscheme)
           (std pregexp)
@@ -803,4 +804,291 @@
                       (string-set! buf k c)
                       (loop (fx+ i 1) (fx+ k 1))]))])))]))
 
+  ;; ========== Required-anchor-set extraction ==========
+  ;;
+  ;; Generalization of regex-required-literal that can return a *set* of
+  ;; literals when the pattern contains a top-level alternation group
+  ;; like `prefix(A|B|C)suffix` (the surrounding pattern may be empty).
+  ;; Returns one of:
+  ;;
+  ;;   #f                 -- no anchor available
+  ;;   (list STR)         -- a single required literal (every match
+  ;;                         contains STR; equivalent to the
+  ;;                         regex-required-literal result)
+  ;;   (list S1 S2 ... Sn) -- every match contains at least one of the
+  ;;                          listed literals (n >= 2)
+  ;;
+  ;; The walker keeps the longest single-literal it finds AND, in
+  ;; parallel, the alt-group whose branches' minimum literal length is
+  ;; the longest.  At the end it returns whichever has the longer
+  ;; minimum literal length (single-literal length wins ties).
+  ;;
+  ;; "Top-level" means not nested inside another group.  An alt group
+  ;; with a quantifier (`(A|B)?`, `(A|B)*`, `(A|B){0,5}`) is skipped --
+  ;; nothing about those is required.  Branches must each yield a
+  ;; non-empty literal (using the same pure-literal rules as
+  ;; regex-pure-literal-alts) for the alt to count.
+  ;;
+  ;; Callers wiring this into an Aho-Corasick automaton can fan a single
+  ;; spec out into N anchor entries when the result has n>=2 elements,
+  ;; gating regex-engine invocation behind any of them firing.
+  (def (regex-required-anchor-set pattern)
+    (let ([str (cond
+                 [(re-object? pattern) (re-object-pat-string pattern)]
+                 [(string? pattern)    pattern]
+                 [else (error 'regex-required-anchor-set
+                              "pattern must be a string or re object" pattern)])])
+      (let ([n (string-length str)])
+        (cond
+          [(fxzero? n) #f]
+          [else
+            (let-values ([(start end) (pla-strip-anchors str 0 n)])
+              (let-values ([(best-lit best-alts)
+                            (anchor-walk-seq str start end "" #f)])
+                (let ([single-len (string-length best-lit)]
+                      [alt-len (cond
+                                 [(pair? best-alts) (anchor-min-len best-alts)]
+                                 [else 0])])
+                  (cond
+                    [(and (fxzero? single-len) (fxzero? alt-len)) #f]
+                    [(fx>= single-len alt-len)
+                      (list best-lit)]
+                    [else best-alts]))))]))))
+
+  ;; Walk the pieces in `s[start..end]` as a sequence (not crossing
+  ;; alternation `|` at the current level).  Returns
+  ;;   (values BEST-SINGLE-LIT BEST-ALTS-OR-#f)
+  ;; where BEST-SINGLE-LIT is the longest single required literal seen
+  ;; (or initial-lit if none beats it) and BEST-ALTS is the alt list
+  ;; with the longest min-branch length seen (or initial-alts).
+  (def (anchor-walk-seq s start end initial-lit initial-alts)
+    (let loop ([i start] [cur ""] [best-lit initial-lit] [best-alts initial-alts])
+      (cond
+        [(fx>= i end)
+          (values (anchor-max-lit cur best-lit) best-alts)]
+        [(or (char=? (string-ref s i) #\|)
+             (char=? (string-ref s i) #\)))
+          (values (anchor-max-lit cur best-lit) best-alts)]
+        [else
+          (let-values ([(piece-lit piece-alts j ok?)
+                        (anchor-scan-piece s i end)])
+            (cond
+              [(not ok?)
+                ;; Unrecognized construct: stop here, return what we have.
+                (values (anchor-max-lit cur best-lit) best-alts)]
+              [else
+                (let ([new-best-alts (anchor-better-alts piece-alts best-alts)])
+                  (cond
+                    [(fxzero? (string-length piece-lit))
+                      ;; This piece contributed no required literal:
+                      ;; flush `cur` to best-lit and reset.
+                      (loop j "" (anchor-max-lit cur best-lit) new-best-alts)]
+                    [else
+                      (loop j (string-append cur piece-lit)
+                              best-lit new-best-alts)]))]))])))
+
+  ;; Scan one piece (atom + optional quantifier).  Returns
+  ;;   (values PIECE-LIT PIECE-ALTS NEW-POS OK?)
+  ;; PIECE-LIT  -- the required literal this piece contributes to the
+  ;;               enclosing sequence ("" if none).
+  ;; PIECE-ALTS -- a non-empty list of pure-literal branches if this
+  ;;               piece is a top-level `(A|B|...)` group with all-
+  ;;               literal branches and NO quantifier; #f otherwise.
+  ;; OK?         -- #t on success; #f for constructs the walker cannot
+  ;;               reason about cleanly (caller should bail).
+  (def (anchor-scan-piece s i n)
+    (let-values ([(atom-lit atom-alts j ok?) (anchor-scan-atom s i n)])
+      (cond
+        [(not ok?) (values "" #f j #f)]
+        [(fx>= j n) (values atom-lit atom-alts j #t)]
+        [else
+          (let ([c (string-ref s j)])
+            (cond
+              [(or (char=? c #\?) (char=? c #\*))
+                ;; Quantifier makes atom optional/repeated -- it
+                ;; contributes no required literal, and any alts it
+                ;; carried no longer apply.
+                (values "" #f (fx+ j 1) #t)]
+              [(char=? c #\+)
+                ;; One or more: the atom is required at least once.
+                (values atom-lit atom-alts (fx+ j 1) #t)]
+              [(char=? c #\{)
+                (let-values ([(lo _hi k) (rl-parse-repeat s (fx+ j 1) n)])
+                  (cond
+                    [(not k) (values "" #f j #f)]
+                    [(and (number? lo) (fx>= lo 1))
+                      (values atom-lit atom-alts k #t)]
+                    [else
+                      (values "" #f k #t)]))]
+              [else (values atom-lit atom-alts j #t)]))])))
+
+  ;; Scan one atom.  Returns (values ATOM-LIT ATOM-ALTS NEW-POS OK?).
+  ;; ATOM-LIT  -- required literal for the atom ("" for unanchorables
+  ;;              like `.`, char classes, alts with non-literal branch).
+  ;; ATOM-ALTS -- non-empty literal-branch list if this atom is a group
+  ;;              whose direct content is a pure-literal alternation;
+  ;;              #f otherwise.
+  (def (anchor-scan-atom s i n)
+    (cond
+      [(fx>= i n) (values "" #f i #t)]
+      [else
+        (let ([c (string-ref s i)])
+          (cond
+            [(or (char=? c #\^) (char=? c #\$))
+              (values "" #f (fx+ i 1) #t)]
+            [(char=? c #\.)
+              (values "" #f (fx+ i 1) #t)]
+            [(char=? c #\[)
+              (let ([k (rl-skip-class s (fx+ i 1) n)])
+                (if k (values "" #f k #t) (values "" #f i #f)))]
+            [(char=? c #\()
+              (anchor-scan-group s i n)]
+            [(char=? c #\\)
+              (cond
+                [(fx>= (fx+ i 1) n) (values "" #f i #f)]
+                [else
+                  (let ([e (string-ref s (fx+ i 1))])
+                    (cond
+                      [(memv e '(#\d #\D #\w #\W #\s #\S #\b #\B
+                                 #\A #\Z #\z))
+                        (values "" #f (fx+ i 2) #t)]
+                      [(memv e '(#\n #\r #\t #\f #\v))
+                        (values (string (rl-escape->char e)) #f (fx+ i 2) #t)]
+                      [(memv e '(#\x #\u #\0 #\1 #\2 #\3 #\4
+                                 #\5 #\6 #\7 #\8 #\9))
+                        (values "" #f i #f)]
+                      [else
+                        (values (string e) #f (fx+ i 2) #t)]))])]
+            [(memv c '(#\) #\| #\? #\* #\+ #\{ #\} #\]))
+              (values "" #f i #f)]
+            [else
+              (values (string c) #f (fx+ i 1) #t)]))]))
+
+  ;; Scan a `(...)` group at position i.  Returns
+  ;;   (values GROUP-LIT GROUP-ALTS NEW-POS OK?)
+  ;; GROUP-LIT  -- required literal across the group's content.  For
+  ;;               single-branch groups, the longest required literal
+  ;;               in that branch.  For multi-branch groups, "" (we
+  ;;               can't guarantee a single substring across all
+  ;;               branches; the caller derives anchors via GROUP-ALTS).
+  ;; GROUP-ALTS -- non-empty list of branch literals if every branch is
+  ;;               a pure literal sequence; otherwise #f.
+  ;;
+  ;; Note: nested groups inside a branch disqualify the alt-set (we
+  ;; conservatively require pure literal branches).
+  (def (anchor-scan-group s i n)
+    (let-values ([(after-prefix ok0) (rl-skip-group-prefix s (fx+ i 1) n)])
+      (cond
+        [(not ok0) (values "" #f i #f)]
+        [else
+          ;; Locate the matching close paren at the current depth.
+          (let walk ([k after-prefix] [depth 0])
+            (cond
+              [(fx>= k n) (values "" #f i #f)]
+              [else
+                (let ([c (string-ref s k)])
+                  (cond
+                    [(char=? c #\\)
+                      (if (fx< (fx+ k 1) n)
+                        (walk (fx+ k 2) depth)
+                        (values "" #f i #f))]
+                    [(char=? c #\[)
+                      (let ([m (rl-skip-class s (fx+ k 1) n)])
+                        (if m (walk m depth) (values "" #f i #f)))]
+                    [(char=? c #\()
+                      (walk (fx+ k 1) (fx+ depth 1))]
+                    [(char=? c #\))
+                      (cond
+                        [(fxzero? depth)
+                          ;; k is the matching close paren.
+                          (let ([alts (pla-split-alts s after-prefix k #t)])
+                            (cond
+                              [(and (pair? alts) (pair? (cdr alts)))
+                                ;; Multi-branch pure-literal alt group.
+                                (values "" alts (fx+ k 1) #t)]
+                              [else
+                                ;; Single branch OR multi-branch with
+                                ;; non-literal content.  Recurse into
+                                ;; the branch(es) to extract the
+                                ;; longest required literal across them.
+                                (let-values ([(branch-lit) (anchor-group-lit s after-prefix k)])
+                                  (values branch-lit #f (fx+ k 1) #t))]))]
+                        [else (walk (fx+ k 1) (fx- depth 1))])]
+                    [else (walk (fx+ k 1) depth)]))]))])))
+
+  ;; For non-pure-literal-alt groups (single branch or branches that
+  ;; contain non-literal pieces), the group's required literal is the
+  ;; literal common to EVERY branch.  Conservative: only single-branch
+  ;; groups yield a non-empty literal; multi-branch groups yield "".
+  ;; (Computing the LCS across branches is left for a future caller
+  ;; that actually needs it.)
+  (def (anchor-group-lit s start end)
+    ;; If there's a `|` at the current top level inside the range, this
+    ;; is a multi-branch group whose branches are not all pure literals
+    ;; (otherwise we'd have returned via the pla-split-alts path).
+    ;; Return "" conservatively.
+    (cond
+      [(top-level-has-alt? s start end) ""]
+      [else
+        (let-values ([(lit _alts)
+                      (anchor-walk-seq s start end "" #f)])
+          lit)]))
+
+  (def (top-level-has-alt? s start end)
+    (let loop ([i start])
+      (cond
+        [(fx>= i end) #f]
+        [else
+          (let ([c (string-ref s i)])
+            (cond
+              [(char=? c #\\)
+                (if (fx< (fx+ i 1) end) (loop (fx+ i 2)) #f)]
+              [(char=? c #\[)
+                (let ([k (rl-skip-class s (fx+ i 1) end)])
+                  (if k (loop k) #f))]
+              [(char=? c #\()
+                (let-values ([(_p _ok) (rl-skip-group-prefix s (fx+ i 1) end)])
+                  (let nest ([k (fx+ i 1)] [d 0])
+                    (cond
+                      [(fx>= k end) #f]
+                      [else
+                        (let ([cc (string-ref s k)])
+                          (cond
+                            [(char=? cc #\\)
+                              (if (fx< (fx+ k 1) end) (nest (fx+ k 2) d) #f)]
+                            [(char=? cc #\[)
+                              (let ([m (rl-skip-class s (fx+ k 1) end)])
+                                (if m (nest m d) #f))]
+                            [(char=? cc #\()
+                              (nest (fx+ k 1) (fx+ d 1))]
+                            [(char=? cc #\))
+                              (cond
+                                [(fxzero? d) (loop (fx+ k 1))]
+                                [else (nest (fx+ k 1) (fx- d 1))])]
+                            [else (nest (fx+ k 1) d)]))])))]
+              [(char=? c #\|) #t]
+              [else (loop (fx+ i 1))]))])))
+
+  (def (anchor-max-lit a b)
+    (if (fx> (string-length a) (string-length b)) a b))
+
+  (def (anchor-min-len lst)
+    (let loop ([xs lst] [m #f])
+      (cond
+        [(null? xs) (or m 0)]
+        [else
+          (let ([k (string-length (car xs))])
+            (loop (cdr xs)
+                  (cond
+                    [(not m) k]
+                    [(fx< k m) k]
+                    [else m])))])))
+
+  (def (anchor-better-alts new old)
+    (cond
+      [(not new) old]
+      [(not old) new]
+      [(fx> (anchor-min-len new) (anchor-min-len old)) new]
+      [else old]))
+
 ) ;; end library