lumbda/quantum/score.lsp
russell@unturf.com 1665893321
factory + quantum + sweep-doctrine: AGPLv3 share-back from foxhop ecdsa
29 new files publish factory infra (V2 autoscaler with live VRAM
sampling + EWMA peak tracking, HUGE solo-dispatch, two-tier DLQ/rDLQ
classifier + retry), general quantum circuit primitives (Cuccaro
ripple-carry adder, Clifford gate library, Clifford tableau simulator,
mod-arith family, dialog GCD reversible inverse, Karatsuba multiplier,
Solinas fast reduction), and a TCRAUDT reducer harness. Originally
developed in ~/git/www.foxhop.net/ecdsa/ for secp256k1 attack-surface
research; published upstream as obligated by AGPLv3.

Parametrization contract at factory/CONTRACT.md. Consumers export
LUMBDA_REPO_DIR + LUMBDA_QUEUE_DIR + LUMBDA_BACKEND_CMD + LUMBDA_EMITTER_CMD
then exec factory scripts. No fork-and-modify; single source of truth
upstream.

Integration tests gate 7 V2 defect classes that wedged a live factory
on 2026-06-12 (skewed-demand starve, zero-floor reservation,
multi-tier greedy, +-25%% damping, cold-start ramp, DLQ surge halve,
post-damp CPU ceiling) + 28 DLQ classifier cases (auto-retry vs
escalate partition) + bash -n syntax lint across every script.

GPU backend stays in consumer trees; rationale in
factory/GPU-BACKEND-NOTE.md. Bend wire protocol + gpu-worker.lsp
already upstream at examples/cuda-fanout/.

make factory-lint                bash -n on every factory/*.sh
make test-integration            V2 reducer + DLQ classifier + syntax gate
make sweep-doctrine              TCRAUDT reducer gate (serial)
make sweep-doctrine-parallel     xargs -P fan-out

Verified on neoblanka: factory-lint 12 scripts PASS; test-integration
14 V2 cases + 28 DLQ classifier cases + 12 syntax cases all PASS.
2026-06-14 10:37:35 -04:00

104 lines
3.7 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; score.lsp — Shot aggregator. Reads many result portals, computes
;;; upstream score = (avg Toffoli per shot) × (peak live-qubit width).
;;;
;;; Per foxhop CLAUDE.md ### ecdsa/ — lumbda asm-tier safety.
;;; *max-shots* bounds every multi-shot run. Default 64 during dev;
;;; raise via (set! *max-shots* N) at top of main.lsp under explicit
;;; fox approval only. Never raise past 1024 on bump-only asm.
(define *max-shots* 64)
(define (clamp-shots requested)
"Clamp requested shot count to *max-shots*, log when clamping fires."
(cond
((< requested 0) 0)
((> requested *max-shots*)
(display ";;; shot count clamped: requested=")
(display requested)
(display " *max-shots*=") (display *max-shots*) (newline)
*max-shots*)
(else requested)))
;;; ── result-portal accessors ─────────────────────────────────
(define (read-portal-file filename)
"Slurp a portal file. Same cross-tier idiom as sim.lsp's read-portal."
(read-from-string (file->string filename)))
(define (result-section r tag)
(let loop ((children (cdr r)))
(cond
((null? children) #f)
((and (pair? (car children)) (eq? (car (car children)) tag))
(cdr (car children)))
(else (loop (cdr children))))))
(define (result-status r)
(let ((s (result-section r 'status)))
(if s (car s) 'unknown)))
(define (counts-field r field)
(let ((counts (result-section r 'counts)))
(cond
((not counts) 0)
(else
(let ((row (assoc field counts)))
(if row (car (cdr row)) 0))))))
(define (result-toffoli r) (counts-field r 'toffoli))
(define (result-clifford r) (counts-field r 'clifford))
(define (result-peak-qubits r) (counts-field r 'peak-qubits))
;;; ── aggregation across many result portals ──────────────────
(define (aggregate-results paths)
"Walk a list of result-portal paths. Drops shots whose status is not
ok (counts them as rejects). Returns alist with raw totals so any
consumer can recompute the score precisely."
(let loop ((rest paths)
(n 0)
(toffoli-sum 0)
(clifford-sum 0)
(peak-max 0)
(rejects 0))
(cond
((null? rest)
(list (cons 'shots n)
(cons 'rejects rejects)
(cons 'toffoli-sum toffoli-sum)
(cons 'clifford-sum clifford-sum)
(cons 'peak-qubits peak-max)
(cons 'score-num (* toffoli-sum peak-max))
(cons 'score-den (if (= n 0) 1 n))
(cons 'avg-toffoli (if (= n 0) 0 (quotient toffoli-sum n)))
(cons 'score (if (= n 0)
0
(quotient (* toffoli-sum peak-max) n)))))
(else
(let ((r (read-portal-file (car rest))))
(cond
((eq? (result-status r) 'ok)
(loop (cdr rest)
(+ n 1)
(+ toffoli-sum (result-toffoli r))
(+ clifford-sum (result-clifford r))
(cond ((> (result-peak-qubits r) peak-max)
(result-peak-qubits r))
(else peak-max))
rejects))
(else
(loop (cdr rest)
n
toffoli-sum
clifford-sum
peak-max
(+ rejects 1)))))))))
(define (write-summary! path summary)
"Write aggregated summary to a portal-style S-expression file."
(let* ((tmp (string-append path ".tmp"))
(port (open-output-file tmp)))
(write (cons 'summary summary) port)
(newline port)
(close-port port)
(rename-file tmp path)))