russell@unturf.com
192118388f
Zoë Trout's favorites at wedgewack.org/ursa.lisp.txt are Common Lisp:
iterative LOOP macros, setf cascades, defun with &optional, image-
based stone-lisp culture. Her first contribution to lumbda was a
question — "do we care for our programs, and how long are they alive
for?" — and the answer now extends beyond the RNG portal (§7.5) to
iteration style itself.
Four-phase delivery, all under ticket 0004:
Phase A — idiomatic Scheme ports at examples/ursa-scheme.lsp.
Every Zoë defun rewritten as named-let + tail recursion + list-
backed work queue + type-predicate dispatch.
Phase B — CL compat shim at cl-compat.lsp.
defun (with &optional), setf (simple vars, multi-pair), flet,
multiple-value-bind, t / nil (nil=#f so cond/if compose),
evenp/oddp/plusp/minusp/zerop, mod/ash/logbitp/nreverse,
cl-when/cl-unless (plain when is a void-returning lumbda special
form), declare (no-op), cddddr (missing accessor).
Phase C — cl-loop macro covering 14 patterns.
while/until/repeat, for VAR from A to/below/downto B, for VAR =
INIT [then STEP], for VAR across VEC, of-type T, do, when/unless
return, finally (return VAL). Sequential do*-style stepping via
gensym + cl-subst. Look-ahead termination so `repeat 4 for s = 4
then (- (* s s) 2) finally (return s)` returns 37634 (pre-step)
rather than 1416317954 (post-step). Every expansion ends in a
named-let tail call — TCO holds for loops of any length.
Phase D — load examples/ursa.lisp.txt with minimal annotation.
Preserves Zoë's CL. Minimal edits documented in file header:
load cl-compat.lsp, loop→cl-loop, when→cl-when, random→random-int,
&key→&optional. rho/digits omitted (need make-array/CLOS — see
ticket 0004 for scope boundary).
Defect uncovered along the way (c/types.c env_lookup): a "global
shortcut" checked global env immediately after missing the local
frame, SKIPPING intermediate parent scopes. Broke lexical scoping
whenever a parent scope shadowed a global. Reproduced with
(define s 4)
(let ((s 100)) (let ((m 0)) s)) ; returned 4, should return 100
Any nested let whose body referenced a shadowed name silently read
the global. Fix: remove the shortcut, walk the parent chain end-to-
end. 1255 assertions across five suites pass unchanged after fix —
surfaced only because cl-loop iterator names routinely collide with
globals accumulated in a stone-lisp image.
Whitepaper §9.2 documents the CL-in-Scheme design and the guarantees
that survive (TCO, portal determinism, cross-impl reproducibility).
Zoë added to authors + acknowledgments; reacknowledgment reframes
her first contribution as the deeper program-lifetime question, with
RNG portal as a derivative (§7.5) and cl-loop as the follow-up.
Tests: tests/cl-compat.lsp (44 assertions) and tests/ursa.lsp (28
assertions) exercise both paths under Python + C via tests/zoe-
favorites-test.sh, wired into make test-all.
MOAD notes: unmoad flags memq/assq in cl-compat.lsp over cl-loop-
keywords (~30 elements, constant) and var->new (≤4 state vars per
loop). Both are macro-expansion-time, bounded-small-N — not runtime
hot paths. Pre-existing c/types.c findings (strcmp-in-loop for
record-type lookup) are not from this change.
70 lines
3.6 KiB
Text
70 lines
3.6 KiB
Text
;; tests/ursa.lsp — acceptance tests for Zoë Trout's favorite programs.
|
|
;; Runs both Scheme-port (examples/ursa-scheme.lsp) and CL-original
|
|
;; (examples/ursa.lisp.txt via cl-compat.lsp) paths, verifies matching
|
|
;; answers. See ticket 0004 and whitepaper §9.2.
|
|
|
|
(define *pass* 0)
|
|
(define *fail* 0)
|
|
(define (check name got expected)
|
|
(cond ((equal? got expected)
|
|
(set! *pass* (+ *pass* 1))
|
|
(display "PASS: ") (display name) (newline))
|
|
(else
|
|
(set! *fail* (+ *fail* 1))
|
|
(display "FAIL: ") (display name)
|
|
(display " got=") (write got)
|
|
(display " expected=") (write expected) (newline))))
|
|
|
|
;; ── Scheme port ──────────────────────────────────────────────────
|
|
(load "examples/ursa-scheme.lsp")
|
|
(random-seed! 42)
|
|
|
|
(check "s:expt-mod-3^7%100" (expt-mod 3 7 100) 87)
|
|
(check "s:expt-mod-big" (expt-mod 2 100 1000) 376)
|
|
(check "s:primep-97" (primep 97) 97)
|
|
(check "s:primep-100" (primep 100) #f)
|
|
(check "s:factor-12" (factor 12) '(2 2 3))
|
|
(check "s:factor-1001" (factor 1001) '(7 11 13))
|
|
(check "s:mersenne-5" (mersenne-number 5) 31)
|
|
(check "s:ll-residue-5" (lucas-lehmer-residue 5) 0)
|
|
(check "s:ll-primep-5" (lucas-lehmer-primep 5) #t)
|
|
(check "s:ll-primep-11" (lucas-lehmer-primep 11) #f)
|
|
(check "s:ll-primep-13" (lucas-lehmer-primep 13) #t)
|
|
(check "s:repunit-5" (repunit-value 5) 31)
|
|
(check "s:digits-42-2" (digits 42 2) #(1 0 1 0 1 0))
|
|
(check "s:digits-roundtrip" (digits (digits 1234 16) 16) 1234)
|
|
(let ((v (of-n-bits 8)))
|
|
(check "s:of-n-bits" (and (>= v 128) (< v 256)) #t))
|
|
|
|
;; ── CL original (loaded via cl-compat) ──────────────────────────
|
|
;; Load cl-compat + ursa.lisp.txt. The CL file REDEFINES the same
|
|
;; symbols (expt-mod, miller-rabin, ...) via defun macro — after this
|
|
;; load, the names point at the CL-path implementations.
|
|
(load "examples/ursa.lisp.txt")
|
|
(random-seed! 42)
|
|
|
|
(check "c:expt-mod-3^7%100" (expt-mod 3 7 100) 87)
|
|
;; (expt-mod 2 k m) takes the (ash 1 k) fast path in Zoë's CL; keep
|
|
;; k small enough that (expt 2 k) fits lumbda-C's 48-bit int domain.
|
|
(check "c:expt-mod-2^30" (expt-mod 2 30 1000) 824)
|
|
(check "c:primep-97" (primep 97) 97)
|
|
(check "c:primep-100" (primep 100) #f)
|
|
(check "c:mersenne-5" (mersenne-number 5) 31)
|
|
(check "c:ll-primep-5" (lucas-lehmer-primep 5) #t)
|
|
(check "c:ll-primep-11" (lucas-lehmer-primep 11) #f)
|
|
(check "c:ll-primep-13" (lucas-lehmer-primep 13) #t)
|
|
(check "c:repunit-5" (repunit-value 5) 31)
|
|
(check "c:repunit-4-10" (repunit-value 4 1 10) 1111)
|
|
(let ((v (of-n-bits 8)))
|
|
(check "c:of-n-bits" (and (>= v 128) (< v 256)) #t))
|
|
(let ((p (prime-of-n-bits 8)))
|
|
(check "c:prime-of-n-bits" (and (primep p) (>= p 128) (< p 256)) #t))
|
|
;; rhoff is probabilistic — retries are expected. factor (from the
|
|
;; Scheme port, still bound after CL load) wraps rhoff with the retry
|
|
;; loop. Composed with CL's rhoff, the final factoring still holds.
|
|
(check "c:factor-via-rhoff" (factor 15) '(3 5))
|
|
|
|
(display "══════════════════════════════") (newline)
|
|
(display "ursa: ") (display *pass*) (display " passed, ")
|
|
(display *fail*) (display " failed") (newline)
|
|
(if (> *fail* 0) (exit 1))
|