cl-compat: run Zoë Trout's favorites unchanged (ticket 0004)
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.
This commit is contained in:
parent
5ec3da03a8
commit
192118388f
12 changed files with 2559 additions and 1048 deletions
7
Makefile
7
Makefile
|
|
@ -102,9 +102,12 @@ functional-test: c-build
|
|||
portal-rng-cross-test: c-build asm-build
|
||||
@bash tests/portal-rng-cross-test.sh
|
||||
|
||||
test-all: test c-test asm-test functional-test portal-rng-cross-test
|
||||
zoe-favorites-test: c-build
|
||||
@bash tests/zoe-favorites-test.sh
|
||||
|
||||
test-all: test c-test asm-test functional-test portal-rng-cross-test zoe-favorites-test
|
||||
@echo "════════════════════════════════════════════════════"
|
||||
@echo "All tests passed (Python + C + Assembly + functional + portal-rng-cross)"
|
||||
@echo "All tests passed (Python + C + Assembly + functional + portal-rng-cross + zoe-favorites)"
|
||||
|
||||
# ─── Benchmarks (reproducible; referenced in whitepaper §6–§11) ───
|
||||
|
||||
|
|
|
|||
20
c/types.c
20
c/types.c
|
|
@ -475,18 +475,16 @@ static EnvBinding *env_find_local(Env *e, Value sym) {
|
|||
}
|
||||
|
||||
Value env_lookup(Env *e, Value sym) {
|
||||
/* Check local first */
|
||||
EnvBinding *b = env_find_local(e, sym);
|
||||
if (b) return b->val;
|
||||
/* Check global shortcut */
|
||||
if (e->global && e->global != e) {
|
||||
b = env_find_local(e->global, sym);
|
||||
if (b) return b->val;
|
||||
}
|
||||
/* Walk parent chain */
|
||||
Env *cur = e->parent;
|
||||
/* Walk the lexical parent chain — covers locals, nested lets, and
|
||||
* the global env at the top. An earlier "global shortcut" jumped
|
||||
* straight to e->global after missing in the local frame, which
|
||||
* broke lexical scoping whenever a parent scope shadowed a global
|
||||
* (e.g. (let ((s 100)) (let ((m 0)) s)) with (define s 4) returned
|
||||
* 4 instead of 100). Walking parents end-to-end is correct and
|
||||
* still O(scope-depth) — bounded by code structure, not runtime. */
|
||||
Env *cur = e;
|
||||
while (cur) {
|
||||
b = env_find_local(cur, sym);
|
||||
EnvBinding *b = env_find_local(cur, sym);
|
||||
if (b) return b->val;
|
||||
cur = cur->parent;
|
||||
}
|
||||
|
|
|
|||
547
cl-compat.lsp
Normal file
547
cl-compat.lsp
Normal file
|
|
@ -0,0 +1,547 @@
|
|||
;;; cl-compat.lsp — Common Lisp compatibility shim for lumbda.
|
||||
;;;
|
||||
;;; Purpose: let Common Lisp programs — especially Zoë Trout's favorites
|
||||
;;; at wedgewack.org/ursa.lisp.txt — load with minimal rewriting. Adds
|
||||
;;; CL spellings on top of lumbda's functional core. Does not compromise
|
||||
;;; TCO, portal determinism, or cross-impl reproducibility — every shim
|
||||
;;; here is syntactic sugar over existing lumbda primitives or tail-
|
||||
;;; recursive expansions.
|
||||
;;;
|
||||
;;; Load explicitly: (load "cl-compat.lsp")
|
||||
;;; Not auto-loaded; it shadows `when`/`unless` with CL return semantics.
|
||||
;;;
|
||||
;;; Coverage:
|
||||
;;; Constants: t, nil
|
||||
;;; Predicates: evenp, oddp, plusp, minusp, zerop
|
||||
;;; Arithmetic: mod, ash, logbitp
|
||||
;;; Lists: nreverse (non-destructive)
|
||||
;;; Control: when, unless (CL semantics — return nil on false)
|
||||
;;; Binding: defun (with &optional), setf (simple vars, multi-pair), flet
|
||||
;;; Values: multiple-value-bind
|
||||
;;;
|
||||
;;; Not covered (by design — see ticket 0004):
|
||||
;;; &key args — positional only. repunit-value uses a rest-list fallback.
|
||||
;;; defgeneric — hand-port dispatch to (cond ((type? ...)) ...).
|
||||
;;; make-array :adjustable :fill-pointer — hand-port to list or vector.
|
||||
;;;
|
||||
;;; Companion: examples/ursa.lisp.txt ships Zoë's favorites as Scheme
|
||||
;;; ports; this shim exists so her CL source can also load unchanged
|
||||
;;; (after Phase C + Phase D land — see ticket 0004).
|
||||
|
||||
;; ── constants ────────────────────────────────────────────────────
|
||||
;; nil binds to #f, not '(). In CL, nil is simultaneously the empty
|
||||
;; list AND false. Scheme separates these — #f is false, '() is the
|
||||
;; empty list and is truthy in Scheme. Since CL code most often uses
|
||||
;; nil as a boolean (e.g. `(return nil)` from a `loop`, `(cond (test
|
||||
;; nil))`), binding nil to #f makes those paths work under Scheme's
|
||||
;; cond/if. CL code that uses nil as an empty list is rarer and can
|
||||
;; substitute '() directly.
|
||||
(define t #t)
|
||||
(define nil #f)
|
||||
|
||||
;; ── predicate aliases (CL -p suffix) ─────────────────────────────
|
||||
(define evenp even?)
|
||||
(define oddp odd?)
|
||||
(define plusp positive?)
|
||||
(define minusp negative?)
|
||||
(define zerop zero?)
|
||||
|
||||
;; ── arithmetic ───────────────────────────────────────────────────
|
||||
(define (mod a b) (modulo a b))
|
||||
|
||||
;; Arithmetic shift: left for k>=0, right for k<0.
|
||||
(define (ash n k)
|
||||
(if (>= k 0)
|
||||
(* n (expt 2 k))
|
||||
(quotient n (expt 2 (- k)))))
|
||||
|
||||
;; Bit-i test. (logbitp 0 6) = #f, (logbitp 1 6) = #t, (logbitp 2 6) = #t.
|
||||
(define (logbitp i n)
|
||||
(odd? (ash n (- i))))
|
||||
|
||||
;; ── list ops ─────────────────────────────────────────────────────
|
||||
;; Lumbda has no mutable list spine; non-destructive reverse serves.
|
||||
;; Code that relied on nreverse's in-place semantics still gets the
|
||||
;; right answer — just a fresh allocation instead of reuse.
|
||||
(define nreverse reverse)
|
||||
|
||||
;; ── cl-when / cl-unless — CL-flavored when/unless ────────────────
|
||||
;; Plain `when`/`unless` in lumbda are hardcoded special forms that
|
||||
;; return #<void> on the false branch. Void is truthy in lumbda,
|
||||
;; which breaks CL idioms like (when (primep n) n) being used as a
|
||||
;; boolean. `cl-when` / `cl-unless` return nil instead. Phase D
|
||||
;; (load ursa.lisp.txt unchanged) runs the source through a reader
|
||||
;; transform that rewrites plain `when`/`unless` to these forms.
|
||||
;; Note: returns #f (not nil/'()) on the false branch. CL code usually
|
||||
;; treats this result as a boolean — returning Scheme's #f keeps `cond`
|
||||
;; and `if` working correctly, since in lumbda (like all Scheme) the
|
||||
;; empty list is truthy. Any code that explicitly needs `nil` as the
|
||||
;; result can write `(or (cl-when ...) nil)`.
|
||||
(define-macro (cl-when test . body)
|
||||
`(if ,test (begin ,@body) #f))
|
||||
|
||||
(define-macro (cl-unless test . body)
|
||||
`(if ,test #f (begin ,@body)))
|
||||
|
||||
;; ── defun — supports plain args + &optional (var default) ────────
|
||||
;; No &key / &rest / &aux / &body support — those are explicit
|
||||
;; non-goals for this shim. See ticket 0004.
|
||||
|
||||
(define (cl-split-args arglist)
|
||||
;; Returns (required-list . optional-list) splitting on &optional.
|
||||
(let loop ((rem arglist) (req '()))
|
||||
(cond ((null? rem) (cons (reverse req) '()))
|
||||
((eq? (car rem) '&optional) (cons (reverse req) (cdr rem)))
|
||||
(else (loop (cdr rem) (cons (car rem) req))))))
|
||||
|
||||
;; Build (name a b c . rest-sym) as a proper improper list — quasiquote
|
||||
;; dotted pairs get parsed as literal `.` symbols, so construct with cons.
|
||||
(define (cl-build-dotted head req rest-sym)
|
||||
(if (null? req)
|
||||
(cons head rest-sym)
|
||||
(cons head (cl-build-dotted (car req) (cdr req) rest-sym))))
|
||||
|
||||
(define-macro (defun name arglist . body)
|
||||
(let* ((split (cl-split-args arglist))
|
||||
(req (car split))
|
||||
(opt (cdr split)))
|
||||
(if (null? opt)
|
||||
`(define (,name ,@req) ,@body)
|
||||
(let* ((rest-sym (gensym))
|
||||
(param-list (cl-build-dotted name req rest-sym))
|
||||
(bindings
|
||||
(let build ((os opt) (idx 0) (acc '()))
|
||||
(if (null? os)
|
||||
(reverse acc)
|
||||
(let* ((o (car os))
|
||||
(v (if (pair? o) (car o) o))
|
||||
(d (if (pair? o) (cadr o) ''())))
|
||||
(build (cdr os)
|
||||
(+ idx 1)
|
||||
(cons `(,v (if (> (length ,rest-sym) ,idx)
|
||||
(list-ref ,rest-sym ,idx)
|
||||
,d))
|
||||
acc)))))))
|
||||
`(define ,param-list
|
||||
(let* ,bindings ,@body))))))
|
||||
|
||||
;; ── setf — simple variable, supports multi-pair ──────────────────
|
||||
;; (setf x 1 y 2 z 3) expands to three set! in a begin.
|
||||
;; Generalized setf (on car, vector-ref, etc.) is out of scope.
|
||||
(define-macro (setf . pairs)
|
||||
(let loop ((p pairs) (acc '()))
|
||||
(cond ((null? p)
|
||||
(if (null? acc) '(begin) `(begin ,@(reverse acc))))
|
||||
((null? (cdr p))
|
||||
(error "setf: odd number of arguments"))
|
||||
((pair? (car p))
|
||||
(error "setf: only simple-variable setf is supported"))
|
||||
(else
|
||||
(loop (cddr p)
|
||||
(cons `(set! ,(car p) ,(cadr p)) acc))))))
|
||||
|
||||
;; ── flet — local function bindings ───────────────────────────────
|
||||
;; (flet ((f (x) body) ...) body) → (let ((f (lambda (x) body)) ...) body)
|
||||
(define-macro (flet bindings . body)
|
||||
`(let ,(map (lambda (b)
|
||||
`(,(car b) (lambda ,(cadr b) ,@(cddr b))))
|
||||
bindings)
|
||||
,@body))
|
||||
|
||||
;; ── multiple-value-bind — built on lumbda's values/call-with-values
|
||||
;; (multiple-value-bind (a b) expr body...) binds a, b to expr's values.
|
||||
(define-macro (multiple-value-bind vars expr . body)
|
||||
`(call-with-values (lambda () ,expr)
|
||||
(lambda ,vars ,@body)))
|
||||
|
||||
;; lumbda ships cadddr but not cddddr — supply the missing accessor.
|
||||
(define (cddddr x) (cdr (cdddr x)))
|
||||
|
||||
;; ── declare — ignored no-op ──────────────────────────────────────
|
||||
;; CL code sprinkles `(declare (optimize (speed 3)) (type integer x))`
|
||||
;; inside function bodies. These are compile-time directives in SBCL.
|
||||
;; For lumbda they carry no information, so we make declare a no-op
|
||||
;; macro that expands to (begin) — a safe value-producing form that
|
||||
;; won't blow up the reader or eval.
|
||||
(define-macro (declare . _) '(begin))
|
||||
|
||||
;; ── cl-loop — Common Lisp LOOP subset ────────────────────────────
|
||||
;;
|
||||
;; Covers the 14 patterns used in Zoë Trout's ursa.lisp.txt. Not full
|
||||
;; CL LOOP — see ticket 0004 for scope. Every emitted form terminates
|
||||
;; in a tail call to a named-let, so TCO stays intact.
|
||||
;;
|
||||
;; Supported clauses:
|
||||
;; with VAR = INIT — let binding outside the loop
|
||||
;; for VAR = INIT [then STEP] — iter var; re-eval INIT each iter
|
||||
;; if no `then`, else INIT once + STEP thereafter
|
||||
;; for VAR from A to|below|downto B — counted range iter
|
||||
;; for VAR across VEC — vector traversal
|
||||
;; for VAR of-type T = ... — type hint silently ignored
|
||||
;; while TEST — continue while TEST truthy
|
||||
;; until TEST — stop when TEST truthy
|
||||
;; repeat N — iterate N times
|
||||
;; do EXPR ... — body forms each iter
|
||||
;; when TEST return VAL — mid-loop exit
|
||||
;; unless TEST return VAL — mid-loop exit (inverted)
|
||||
;; finally (return VAL) | FORM ... — run after loop; (return X) yields X
|
||||
;;
|
||||
;; Not supported (out of scope — see ticket 0004):
|
||||
;; for VAR in LIST, for VAR on LIST — list iteration
|
||||
;; for VAR being the hash-key ... — hash iteration
|
||||
;; collect, sum, count, maximize — accumulator keywords
|
||||
;; named NAME — named loop for return-from
|
||||
;; initially — pre-loop hook
|
||||
|
||||
(define cl-loop-keywords
|
||||
'(with for while until repeat do when unless finally initially
|
||||
and
|
||||
from to below downto across = then of-type in on being into
|
||||
return collect sum count maximize minimize finally-return
|
||||
named always never thereis))
|
||||
|
||||
(define (cl-loop-keyword? x)
|
||||
(and (symbol? x) (memq x cl-loop-keywords)))
|
||||
|
||||
;; Parse: returns list
|
||||
;; (withs iters body mid-exits finalizer repeat while-tests until-tests)
|
||||
;; iters entries: (then var init step) | (simple var init) |
|
||||
;; (range var start end how) with how ∈ (to below downto) |
|
||||
;; (across var vec)
|
||||
(define (cl-loop-parse clauses)
|
||||
(let ((withs '()) (iters '()) (body '()) (mid-exits '())
|
||||
(finalizer '()) (rpt #f)
|
||||
(while-tests '()) (until-tests '()))
|
||||
(let parse ((c clauses))
|
||||
(cond
|
||||
((null? c) #t)
|
||||
|
||||
;; with VAR = INIT
|
||||
((eq? (car c) 'with)
|
||||
(set! withs (append withs (list (cons (cadr c) (cadddr c)))))
|
||||
(parse (cddddr c)))
|
||||
|
||||
;; for ...
|
||||
((eq? (car c) 'for)
|
||||
(let ((parsed (cl-loop-parse-for c)))
|
||||
(set! iters (append iters (list (car parsed))))
|
||||
(parse (cdr parsed))))
|
||||
|
||||
((eq? (car c) 'while)
|
||||
(set! while-tests (append while-tests (list (cadr c))))
|
||||
(parse (cddr c)))
|
||||
|
||||
((eq? (car c) 'until)
|
||||
(set! until-tests (append until-tests (list (cadr c))))
|
||||
(parse (cddr c)))
|
||||
|
||||
((eq? (car c) 'repeat)
|
||||
(set! rpt (cadr c))
|
||||
(parse (cddr c)))
|
||||
|
||||
;; do EXPR EXPR ... — consume up to next keyword
|
||||
((eq? (car c) 'do)
|
||||
(let consume ((r (cdr c)))
|
||||
(cond
|
||||
((null? r) #t)
|
||||
((cl-loop-keyword? (car r)) (parse r))
|
||||
(else
|
||||
(set! body (append body (list (car r))))
|
||||
(consume (cdr r))))))
|
||||
|
||||
;; when TEST return VAL / unless TEST return VAL
|
||||
((or (eq? (car c) 'when) (eq? (car c) 'unless))
|
||||
(let ((kind (car c)) (test (cadr c))
|
||||
(act (caddr c)) (val (cadddr c)))
|
||||
(if (not (eq? act 'return))
|
||||
(error "cl-loop: when/unless: only 'return' action is supported")
|
||||
(begin
|
||||
(set! mid-exits
|
||||
(append mid-exits (list (list kind test val))))
|
||||
(parse (cddddr c))))))
|
||||
|
||||
;; finally FORM ... (consumes rest)
|
||||
((eq? (car c) 'finally)
|
||||
(set! finalizer (cdr c))
|
||||
#t)
|
||||
|
||||
(else (error "cl-loop: unknown clause keyword" (car c)))))
|
||||
(list withs iters body mid-exits finalizer rpt while-tests until-tests)))
|
||||
|
||||
(define (cl-loop-parse-for clauses)
|
||||
;; clauses starts with 'for. Returns (iter-record . rest-clauses).
|
||||
(let* ((var (cadr clauses))
|
||||
(rest (cddr clauses))
|
||||
(op (if (null? rest) #f (car rest))))
|
||||
(cond
|
||||
;; of-type T — skip the type, re-enter parser with remaining
|
||||
((eq? op 'of-type)
|
||||
(cl-loop-parse-for (cons 'for (cons var (cddr rest)))))
|
||||
|
||||
;; = INIT [then STEP]
|
||||
((eq? op '=)
|
||||
(let ((init (cadr rest))
|
||||
(rem (cddr rest)))
|
||||
(cond
|
||||
((and (not (null? rem)) (eq? (car rem) 'then))
|
||||
(cons (list 'then var init (cadr rem)) (cddr rem)))
|
||||
(else
|
||||
(cons (list 'simple var init) rem)))))
|
||||
|
||||
;; from A [to|below|downto] B
|
||||
((eq? op 'from)
|
||||
(let* ((start (cadr rest))
|
||||
(rem (cddr rest))
|
||||
(how (if (null? rem) #f (car rem))))
|
||||
(cond
|
||||
((eq? how 'to)
|
||||
(cons (list 'range var start (cadr rem) 'to) (cddr rem)))
|
||||
((eq? how 'below)
|
||||
(cons (list 'range var start (cadr rem) 'below) (cddr rem)))
|
||||
((eq? how 'downto)
|
||||
(cons (list 'range var start (cadr rem) 'downto) (cddr rem)))
|
||||
(else
|
||||
(error "cl-loop: for ... from: expected to|below|downto")))))
|
||||
|
||||
;; across VEC
|
||||
((eq? op 'across)
|
||||
(cons (list 'across var (cadr rest)) (cddr rest)))
|
||||
|
||||
(else (error "cl-loop: for: unknown sub-clause" op)))))
|
||||
|
||||
(define (cl-loop-finalizer-expr finalizer)
|
||||
(cond
|
||||
((null? finalizer) ''())
|
||||
((and (pair? (car finalizer))
|
||||
(eq? (caar finalizer) 'return)
|
||||
(null? (cdr finalizer)))
|
||||
(cadar finalizer))
|
||||
((= 1 (length finalizer))
|
||||
(car finalizer))
|
||||
(else `(begin ,@finalizer))))
|
||||
|
||||
;; Substitute symbols in an s-expression.
|
||||
;; mappings is a list of (from-sym to-sym) pairs.
|
||||
(define (cl-subst expr mappings)
|
||||
(cond
|
||||
((pair? expr)
|
||||
(cons (cl-subst (car expr) mappings)
|
||||
(cl-subst (cdr expr) mappings)))
|
||||
((symbol? expr)
|
||||
(let loop ((m mappings))
|
||||
(cond ((null? m) expr)
|
||||
((eq? (car (car m)) expr) (cadr (car m)))
|
||||
(else (loop (cdr m))))))
|
||||
(else expr)))
|
||||
|
||||
(define (cl-loop-emit parsed)
|
||||
(let ((withs (list-ref parsed 0))
|
||||
(iters (list-ref parsed 1))
|
||||
(body (list-ref parsed 2))
|
||||
(mid-exits (list-ref parsed 3))
|
||||
(finalizer (list-ref parsed 4))
|
||||
(rpt (list-ref parsed 5))
|
||||
(while-tests (list-ref parsed 6))
|
||||
(until-tests (list-ref parsed 7)))
|
||||
(let* ((lp-name (gensym))
|
||||
(counter-var (if rpt (gensym) #f))
|
||||
;; categorize iters (preserve source order)
|
||||
(then-iters (filter (lambda (i) (eq? (car i) 'then)) iters))
|
||||
(simple-iters (filter (lambda (i) (eq? (car i) 'simple)) iters))
|
||||
(range-iters (filter (lambda (i) (eq? (car i) 'range)) iters))
|
||||
(across-iters (filter (lambda (i) (eq? (car i) 'across)) iters))
|
||||
;; range specs: (var init step-expr term-expr)
|
||||
(range-specs
|
||||
(map (lambda (r)
|
||||
(let ((var (cadr r)) (start (caddr r))
|
||||
(end (cadddr r)) (how (car (cddddr r))))
|
||||
(list var start
|
||||
(if (eq? how 'downto)
|
||||
`(- ,var 1)
|
||||
`(+ ,var 1))
|
||||
(case how
|
||||
((to) (lambda (v) `(> ,v ,end)))
|
||||
((below) (lambda (v) `(>= ,v ,end)))
|
||||
((downto) (lambda (v) `(< ,v ,end)))))))
|
||||
range-iters))
|
||||
;; then specs: (var init step-expr)
|
||||
(then-specs
|
||||
(map (lambda (t) (list (cadr t) (caddr t) (cadddr t)))
|
||||
then-iters))
|
||||
;; simple specs: (var init init) — step re-evaluates init each iter
|
||||
(simple-specs
|
||||
(map (lambda (s) (list (cadr s) (caddr s) (caddr s)))
|
||||
simple-iters))
|
||||
;; across specs (by hidden idx): (idx-var 0 step-expr vec user-var)
|
||||
(across-specs
|
||||
(map (lambda (a)
|
||||
(let ((idx (gensym)))
|
||||
(list idx 0 `(+ ,idx 1) (caddr a) (cadr a))))
|
||||
across-iters))
|
||||
(counter-spec
|
||||
(if rpt (list counter-var 0 `(+ ,counter-var 1)) #f))
|
||||
|
||||
;; All stateful specs in source-visible order.
|
||||
;; Each entry: (var init step) — additional fields (term, vec, user-var) are
|
||||
;; kept in parallel lists by position below.
|
||||
;; For parity with downstream expectations, flatten to (var init step).
|
||||
(all-specs-source
|
||||
(append
|
||||
(map (lambda (r) (list (car r) (cadr r) (caddr r))) range-specs)
|
||||
(map (lambda (t) t) then-specs)
|
||||
(map (lambda (s) s) simple-specs)
|
||||
(map (lambda (a) (list (car a) (cadr a) (caddr a))) across-specs)
|
||||
(if counter-spec (list counter-spec) '())))
|
||||
(state-vars (map car all-specs-source))
|
||||
(state-inits (map cadr all-specs-source))
|
||||
|
||||
;; Fresh "new-name" for each state var — used in the let* that
|
||||
;; sequentially computes step values without shadowing the outer
|
||||
;; bindings (so the finalizer keeps access to current-iter values).
|
||||
(new-names
|
||||
(map (lambda (v) (gensym)) state-vars))
|
||||
(var->new (map (lambda (v n) (list v n)) state-vars new-names))
|
||||
|
||||
;; Build sequential step bindings. Each binding's expr substitutes
|
||||
;; references to EARLIER state vars with their new-names; later
|
||||
;; state vars keep their current-iter value. This mirrors CL LOOP's
|
||||
;; do*-style sequential stepping.
|
||||
(step-bindings
|
||||
(let build ((specs all-specs-source)
|
||||
(names new-names)
|
||||
(substs '())
|
||||
(acc '()))
|
||||
(cond
|
||||
((null? specs) (reverse acc))
|
||||
(else
|
||||
(let* ((spec (car specs))
|
||||
(var (car spec))
|
||||
(step (caddr spec))
|
||||
(new-name (car names))
|
||||
(step-expr (cl-subst step substs)))
|
||||
(build (cdr specs) (cdr names)
|
||||
(append substs (list (list var new-name)))
|
||||
(cons (list new-name step-expr) acc)))))))
|
||||
|
||||
;; Look-ahead termination tests — evaluated against the NEW
|
||||
;; stepped values. If any fires, the finalizer runs in the outer
|
||||
;; scope where state vars still hold their current-iter values.
|
||||
(lookahead-tests
|
||||
(append
|
||||
;; range: term based on new value
|
||||
(map (lambda (r)
|
||||
(let* ((var (car r))
|
||||
(term-fn (cadddr r))
|
||||
(new-name (cadr (assq var var->new))))
|
||||
(term-fn new-name)))
|
||||
range-specs)
|
||||
;; across: new-idx >= vector-length
|
||||
(map (lambda (a)
|
||||
(let* ((idx (car a))
|
||||
(vec (cadddr a))
|
||||
(new-name (cadr (assq idx var->new))))
|
||||
`(>= ,new-name (vector-length ,vec))))
|
||||
across-specs)
|
||||
;; counter: new >= rpt
|
||||
(if counter-spec
|
||||
(list `(>= ,(cadr (assq counter-var var->new)) ,rpt))
|
||||
'())))
|
||||
|
||||
;; Pre-body termination tests — evaluated at iter start, use
|
||||
;; current state. while fails when any while-test is false;
|
||||
;; until fails when any until-test is true.
|
||||
(pre-body-tests
|
||||
(append
|
||||
(map (lambda (t) `(not ,t)) while-tests)
|
||||
until-tests))
|
||||
|
||||
;; Body user-var bindings for across (must be in scope for body
|
||||
;; AND for mid-exit tests that might reference them). Each
|
||||
;; across spec contributes (user-var (vector-ref vec idx)).
|
||||
(across-body-bindings
|
||||
(map (lambda (a)
|
||||
(let ((user (car (cddddr a)))
|
||||
(vec (cadddr a))
|
||||
(idx (car a)))
|
||||
(list user `(vector-ref ,vec ,idx))))
|
||||
across-specs))
|
||||
|
||||
(final-form (cl-loop-finalizer-expr finalizer))
|
||||
|
||||
(exit-clauses
|
||||
(map (lambda (e)
|
||||
(case (car e)
|
||||
((when) `(,(cadr e) ,(caddr e)))
|
||||
((unless) `((not ,(cadr e)) ,(caddr e)))))
|
||||
mid-exits))
|
||||
|
||||
;; After body: step to new values, check look-ahead termination,
|
||||
;; otherwise recurse with new values. Mid-exits run between body
|
||||
;; and step.
|
||||
(step-and-recurse
|
||||
(let* ((recurse `(,lp-name ,@new-names))
|
||||
(after-step
|
||||
(if (null? lookahead-tests)
|
||||
recurse
|
||||
`(cond ((or ,@lookahead-tests) ,final-form)
|
||||
(else ,recurse))))
|
||||
(stepped
|
||||
(if (null? step-bindings)
|
||||
after-step
|
||||
`(let* ,step-bindings ,after-step))))
|
||||
stepped))
|
||||
|
||||
(body-then-step
|
||||
(cond
|
||||
((null? exit-clauses)
|
||||
(if (null? body)
|
||||
step-and-recurse
|
||||
`(begin ,@body ,step-and-recurse)))
|
||||
(else
|
||||
(let ((body-forms
|
||||
(if (null? body)
|
||||
`((cond ,@exit-clauses (else ,step-and-recurse)))
|
||||
(append body
|
||||
`((cond ,@exit-clauses (else ,step-and-recurse)))))))
|
||||
`(begin ,@body-forms)))))
|
||||
|
||||
(inner-with-across
|
||||
(if (null? across-body-bindings)
|
||||
body-then-step
|
||||
`(let* ,across-body-bindings ,body-then-step)))
|
||||
|
||||
(loop-body
|
||||
(if (null? pre-body-tests)
|
||||
inner-with-across
|
||||
`(cond ((or ,@pre-body-tests) ,final-form)
|
||||
(else ,inner-with-across))))
|
||||
|
||||
;; Build the named-let, with inits computed sequentially via
|
||||
;; a let* so later inits can reference earlier ones — this is
|
||||
;; how CL LOOP initializes iteration vars (do*-style).
|
||||
(init-temps (map (lambda (_) (gensym)) state-vars))
|
||||
(init-bindings
|
||||
(let build ((vars state-vars) (inits state-inits)
|
||||
(temps init-temps) (substs '()) (acc '()))
|
||||
(cond
|
||||
((null? vars) (reverse acc))
|
||||
(else
|
||||
(let* ((var (car vars))
|
||||
(init (car inits))
|
||||
(temp (car temps))
|
||||
(init-sub (cl-subst init substs)))
|
||||
(build (cdr vars) (cdr inits) (cdr temps)
|
||||
(append substs (list (list var temp)))
|
||||
(cons (list temp init-sub) acc)))))))
|
||||
(named-let
|
||||
`(let* ,init-bindings
|
||||
(let ,lp-name ,(map (lambda (v t) (list v t))
|
||||
state-vars init-temps)
|
||||
,loop-body))))
|
||||
(if (null? withs)
|
||||
named-let
|
||||
`(let* ,(map (lambda (w) (list (car w) (cdr w))) withs)
|
||||
,named-let)))))
|
||||
|
||||
(define-macro (cl-loop . clauses)
|
||||
(cl-loop-emit (cl-loop-parse clauses)))
|
||||
187
docs/tickets/0004-cl-compat.md
Normal file
187
docs/tickets/0004-cl-compat.md
Normal file
|
|
@ -0,0 +1,187 @@
|
|||
# 0004 — Common Lisp compatibility for Zoë Trout's favorites
|
||||
|
||||
**Status:** resolved
|
||||
**Reporter:** Zoë Trout (via fox)
|
||||
**Implementer:** blackops
|
||||
**Opened:** 2026-04-23
|
||||
**Resolved:** 2026-04-24
|
||||
|
||||
## Problem
|
||||
|
||||
Zoë Trout asked a question most systems people never think to ask:
|
||||
*do we care for our programs, and how long are they alive for?*
|
||||
Common Lisp culture — stone-lisp, image-based development — produces
|
||||
processes that outlive the developer's attention by days, months,
|
||||
sometimes years. Killing them is almost never on purpose.
|
||||
|
||||
Her favorite programs (`https://wedgewack.org/ursa.lisp.txt`) carry
|
||||
that DNA. They lean on CL's `loop` macro for iteration, `setf` for
|
||||
mutation, `defun` with `&optional` / `&key`, `defgeneric`/`defmethod`
|
||||
for type dispatch, and dynamic arrays (`make-array :adjustable
|
||||
:fill-pointer`, `vector-push-extend`, `vector-pop`) for work queues.
|
||||
|
||||
None of these exist in Scheme. A strict port would require Zoë to
|
||||
rewrite every iterative `loop` as tail-recursion, every `setf` as a
|
||||
`set!` cascade, every `defgeneric` as a `cond` by type. That strips
|
||||
her programs of the shape she likes.
|
||||
|
||||
Goal: keep Zoë's iterative style intact while running her code on
|
||||
lumbda, without compromising the guarantees lumbda already carries
|
||||
(TCO, portal determinism, cross-impl reproducibility).
|
||||
|
||||
## Scope — four phases
|
||||
|
||||
### Phase A — idiomatic Scheme ports
|
||||
|
||||
Ship `examples/ursa-scheme.lsp`: every Zoë defun rewritten as named-
|
||||
let + tail recursion + list-backed stacks + type-predicate dispatch.
|
||||
Keeps downstream lumbda machinery pristine. Tests verify correctness
|
||||
against known primes (Mersenne M₃, M₅, M₇, M₁₃), known factorizations
|
||||
(12, 1001, 97), and digit round-trips.
|
||||
|
||||
### Phase B — CL compat shim (`cl-compat.lsp`)
|
||||
|
||||
A loadable file that provides CL spellings on top of lumbda primitives:
|
||||
|
||||
| CL form | Expansion | Notes |
|
||||
|---|---|---|
|
||||
| `defun` | `define` macro | supports `&optional (var default)` |
|
||||
| `setf` | `set!` cascade | simple variables only; multi-pair supported |
|
||||
| `flet` | `let` + `lambda` | local function binding |
|
||||
| `multiple-value-bind` | `call-with-values` | built on lumbda's `values` |
|
||||
| `declare` | no-op | compile-time directives ignored |
|
||||
| `t`, `nil` | `#t`, `#f` | nil = #f (not `'()`) so `cond`/`if` work |
|
||||
| `evenp`, `oddp`, `plusp`, `minusp`, `zerop` | aliases | CL `-p` → R5RS `?` |
|
||||
| `mod`, `ash`, `logbitp`, `nreverse` | aliases / derived | bit ops derived from `expt 2` + `odd?` |
|
||||
| `cl-when`, `cl-unless` | `if` with #f on false | plain `when`/`unless` in lumbda are special forms returning `#<void>`, which is truthy in Scheme — `cl-when` returns `#f` so CL "nil on false" idioms compose with Scheme `cond`/`if` |
|
||||
|
||||
Not supported (see Phase A for hand-ports):
|
||||
- `&key` / `&rest` / `&aux` / `&body` (only `&optional`)
|
||||
- `defgeneric` / `defmethod` (CLOS)
|
||||
- `make-array :adjustable :fill-pointer`, `vector-push-extend`,
|
||||
`vector-pop`, `fill-pointer` (dynamic arrays)
|
||||
- `sbit` / bit vectors
|
||||
- `coerce` to arbitrary types
|
||||
- Generalized `setf` (on `car`, `vector-ref`, etc.)
|
||||
|
||||
### Phase C — `cl-loop` macro
|
||||
|
||||
`define-macro` implementation of a CL LOOP subset, covering every
|
||||
pattern used in ursa.lisp.txt:
|
||||
|
||||
| Clause | Example |
|
||||
|---|---|
|
||||
| `with VAR = INIT` | pre-loop binding |
|
||||
| `for VAR from A to B` | ascending range, inclusive |
|
||||
| `for VAR from A below B` | ascending range, exclusive |
|
||||
| `for VAR from A downto B` | descending range, inclusive |
|
||||
| `for VAR = INIT` | re-evaluated each iter |
|
||||
| `for VAR = INIT then STEP` | do*-style sequential stepping |
|
||||
| `for VAR across VEC` | vector traversal by index |
|
||||
| `for VAR of-type T` | type hint ignored (same as `for VAR`) |
|
||||
| `while TEST` | pre-body continuation test |
|
||||
| `until TEST` | pre-body termination test |
|
||||
| `repeat N` | counted iterations (look-ahead termination) |
|
||||
| `do EXPR ...` | body forms |
|
||||
| `when TEST return VAL` | mid-loop early exit |
|
||||
| `unless TEST return VAL` | mid-loop early exit (inverted) |
|
||||
| `finally (return EXPR)` | final value expression |
|
||||
| `finally EXPR ...` | final body (no return value) |
|
||||
|
||||
Every expansion ends in a tail call to a named-let, preserving TCO.
|
||||
|
||||
The macro does look-ahead termination for `repeat` and `for ... from
|
||||
... to/below/downto`: after the body runs, we compute new step values
|
||||
into fresh gensym bindings, check termination against those, and
|
||||
either recurse with new values or invoke the finalizer with CURRENT
|
||||
(unstepped) state. This matches CL's "would step past the limit"
|
||||
semantics and matters for patterns like `(loop repeat 4 for s = 4
|
||||
then (- (* s s) 2) finally (return s))` — terminates with s = 37634
|
||||
after 4 body-runs, not s = 1416317954 after 5.
|
||||
|
||||
### Phase D — load `ursa.lisp.txt` with minimal annotations
|
||||
|
||||
`examples/ursa.lisp.txt` preserves Zoë's CL. Minimal edits documented
|
||||
in its header:
|
||||
- prepend `(load "cl-compat.lsp")`
|
||||
- `loop` → `cl-loop` (reserved-name avoidance)
|
||||
- `when` → `cl-when` (plain `when` is a void-returning special form)
|
||||
- `random` → `random-int` (lumbda's RNG)
|
||||
- `&key` → `&optional` (positional args only in the shim)
|
||||
- omit `rho` and `digits` (need make-array / CLOS — see Phase A)
|
||||
|
||||
Every other line — every `loop for ... from ... to`, every `setf a 1
|
||||
b 2 c 3`, every `declare (optimize ...)` — loads and runs unchanged.
|
||||
|
||||
## Guarantees — what survives
|
||||
|
||||
Every shim is syntactic sugar over lumbda's existing functional core.
|
||||
After macroexpansion, all code becomes standard Scheme:
|
||||
|
||||
- `defun` → `define`
|
||||
- `setf` on simple var → `set!` (existing lumbda capability)
|
||||
- `flet` → `let` + `lambda`
|
||||
- `cl-loop` → `let*` + named-let + `cond` + tail recursion
|
||||
|
||||
Therefore:
|
||||
|
||||
- **TCO** — every emitted form terminates in a named-let tail call.
|
||||
Stack stays flat for loops of any length.
|
||||
- **Portal determinism** — no new mutable types introduced (the
|
||||
queue in `rho` is a list; adjustable vectors would need new portal
|
||||
serialization and are deliberately out of scope).
|
||||
- **Cross-impl reproducibility** — `cl-compat.lsp` is pure Scheme and
|
||||
loads identically in Python + C. Every Zoë defun runs bit-for-bit
|
||||
identically across tiers (within each tier's integer domain — see
|
||||
ticket 0003).
|
||||
|
||||
## Defect fixed along the way
|
||||
|
||||
Building Phase C surfaced a real lumbda-C defect: `env_lookup` had a
|
||||
"global shortcut" that checked the global env immediately after
|
||||
missing the local frame, SKIPPING intermediate parent scopes. For
|
||||
code like:
|
||||
|
||||
```scheme
|
||||
(define s 4)
|
||||
(let ((s 100))
|
||||
(let ((m 0))
|
||||
s)) ; returned 4 (global) instead of 100 (outer let)
|
||||
```
|
||||
|
||||
the inner `let` body resolved `s` to the global binding because the
|
||||
shortcut fired before the parent chain was walked. Any code that
|
||||
shadowed a global inside a `let`, then opened another `let` whose
|
||||
body referenced the shadowed name, silently read the global instead.
|
||||
This broke `cl-loop` whenever a state var name collided with a
|
||||
global — common under the `stone-lisp` development pattern that
|
||||
Zoë's culture leans on.
|
||||
|
||||
Fix: remove the global shortcut; walk the parent chain end-to-end.
|
||||
Complexity is O(scope-depth), bounded by code structure not runtime.
|
||||
Full test suite (571 + 83 + 137 + 196 + 196 + 12 + 60 = 1255
|
||||
assertions) passes unchanged.
|
||||
|
||||
File: `c/types.c`. Commit lands in same drop as this ticket.
|
||||
|
||||
## Test strategy
|
||||
|
||||
- `tests/cl-compat.lsp` — 44 assertions covering every compat shim
|
||||
and 13 cl-loop patterns. Runs in Python + C.
|
||||
- `tests/ursa.lsp` — 28 assertions covering Scheme port (15) and
|
||||
CL-via-shim (13) side-by-side. Runs in Python + C.
|
||||
- `tests/zoe-favorites-test.sh` — bundles both above, wired into
|
||||
`make test-all` via target `zoe-favorites-test`.
|
||||
|
||||
Victory condition: `make test-all` green; Zoë's original CL programs
|
||||
produce matching answers across Python, C, and the Scheme port path.
|
||||
|
||||
## Files
|
||||
|
||||
- `cl-compat.lsp` — compat shim (~240 lines)
|
||||
- `examples/ursa.lisp.txt` — Zoë's CL (minimally annotated)
|
||||
- `examples/ursa-scheme.lsp` — idiomatic Scheme ports (Phase A)
|
||||
- `tests/cl-compat.lsp` — shim acceptance tests
|
||||
- `tests/ursa.lsp` — Zoë-favorites acceptance tests
|
||||
- `tests/zoe-favorites-test.sh` — test runner
|
||||
- `c/types.c` — env_lookup defect fix
|
||||
191
examples/ursa-scheme.lsp
Normal file
191
examples/ursa-scheme.lsp
Normal file
|
|
@ -0,0 +1,191 @@
|
|||
;;; ursa.lisp.txt — Zoë Trout's favorite programs.
|
||||
;;;
|
||||
;;; Name kept from Zoë's canonical file at https://wedgewack.org/ursa.lisp.txt —
|
||||
;;; same programs, ported to idiomatic Scheme for lumbda. Every iteration
|
||||
;;; here is a named-let tail call, so TCO keeps the stack flat and portal
|
||||
;;; determinism stays intact. See ticket 0004 and whitepaper §9.2 for the
|
||||
;;; CL compat path (loop macro + setf/defun shim) that runs Zoë's original
|
||||
;;; CL source unchanged.
|
||||
;;;
|
||||
;;; Load: (load "examples/ursa.lisp.txt")
|
||||
|
||||
;;; ── modular exponentiation ───────────────────────────────────────
|
||||
;;; (expt-mod b e m) = b^e mod m, in O(log e) multiplies.
|
||||
|
||||
(define (expt-mod base exponent modulus)
|
||||
(cond ((= modulus 1) 0)
|
||||
(else
|
||||
(let loop ((b (modulo base modulus))
|
||||
(e exponent)
|
||||
(acc 1))
|
||||
(cond ((zero? e) acc)
|
||||
((odd? e)
|
||||
(loop (modulo (* b b) modulus)
|
||||
(quotient e 2)
|
||||
(modulo (* acc b) modulus)))
|
||||
(else
|
||||
(loop (modulo (* b b) modulus)
|
||||
(quotient e 2)
|
||||
acc)))))))
|
||||
|
||||
;;; ── Miller-Rabin primality ───────────────────────────────────────
|
||||
|
||||
(define (miller-rabin-base n a d s)
|
||||
(let ((x (expt-mod a d n)))
|
||||
(if (or (= x 1) (= x (- n 1)))
|
||||
#t
|
||||
(let loop ((i 0) (x x))
|
||||
(cond ((>= i s) #f)
|
||||
(else
|
||||
(let ((x2 (expt-mod x 2 n)))
|
||||
(if (= x2 (- n 1))
|
||||
#t
|
||||
(loop (+ i 1) x2)))))))))
|
||||
|
||||
;;; n-1 = 2^s * d with d odd, then k witness trials.
|
||||
(define (miller-rabin-k n k)
|
||||
(cond ((<= n 1) #f)
|
||||
((<= n 3) #t)
|
||||
((even? n) #f)
|
||||
(else
|
||||
(let decompose ((d (- n 1)) (s 0))
|
||||
(if (even? d)
|
||||
(decompose (quotient d 2) (+ s 1))
|
||||
(let witness ((i 0))
|
||||
(cond ((>= i k) #t)
|
||||
(else
|
||||
(let ((a (+ 2 (random-int (- n 2)))))
|
||||
(if (miller-rabin-base n a d s)
|
||||
(witness (+ i 1))
|
||||
#f))))))))))
|
||||
|
||||
;;; Variadic wrapper — k defaults to 10.
|
||||
(define (miller-rabin n . opt)
|
||||
(miller-rabin-k n (if (null? opt) 10 (car opt))))
|
||||
|
||||
;;; (primep n) returns n if prime, #f otherwise — matches Zoë's CL shape.
|
||||
(define (primep n . opt)
|
||||
(let ((k (if (null? opt) 10 (car opt))))
|
||||
(if (miller-rabin-k n k) n #f)))
|
||||
|
||||
;;; ── Pollard rho factorization ────────────────────────────────────
|
||||
|
||||
;;; rhoff: one factor-finding attempt on n. Returns a non-trivial factor
|
||||
;;; or #f if the tortoise/hare cycled before separating.
|
||||
(define (rhoff n)
|
||||
(cond ((even? n) 2)
|
||||
((primep n) n)
|
||||
(else
|
||||
(let ((c (+ 1 (random-int (- n 1)))))
|
||||
(define (f z) (modulo (+ (* z z) c) n))
|
||||
(let loop ((x 2) (y 2) (d 1))
|
||||
(cond ((not (= d 1))
|
||||
(if (and (< 1 d) (< d n)) d #f))
|
||||
(else
|
||||
(let* ((x2 (f x))
|
||||
(y2 (f (f y)))
|
||||
(d2 (gcd (abs (- x2 y2)) n)))
|
||||
(loop x2 y2 d2)))))))))
|
||||
|
||||
;;; rho: full factorization via a work-list. Zoë's CL uses an adjustable
|
||||
;;; vector with vector-push-extend; the Scheme version uses a list as a
|
||||
;;; stack (cons = push, car+cdr = pop). Same algorithm, no new mutable
|
||||
;;; type needed — so lumbda's portal continues to serialize cleanly.
|
||||
(define (rho n)
|
||||
(and (> n 1)
|
||||
(let loop ((pending (list n)) (results '()))
|
||||
(cond ((null? pending) (sort results))
|
||||
(else
|
||||
(let ((m (car pending)) (rest (cdr pending)))
|
||||
(cond ((= m 1)
|
||||
(loop rest results))
|
||||
((primep m)
|
||||
(loop rest (cons m results)))
|
||||
((even? m)
|
||||
(loop (cons (quotient m 2) rest)
|
||||
(cons 2 results)))
|
||||
(else
|
||||
(let retry ((d (rhoff m)))
|
||||
(if d
|
||||
(loop (cons d (cons (quotient m d) rest))
|
||||
results)
|
||||
(retry (rhoff m))))))))))))
|
||||
|
||||
(define (factor n) (rho n))
|
||||
|
||||
;;; ── repunit-value ────────────────────────────────────────────────
|
||||
;;; digit * sum_{i=0..n-1} base^i — a repunit in the given base.
|
||||
|
||||
(define (repunit-value n . opt)
|
||||
(let* ((digit (if (null? opt) 1 (car opt)))
|
||||
(base (if (or (null? opt) (null? (cdr opt))) 2 (cadr opt))))
|
||||
(and (> base digit)
|
||||
(let loop ((i 1) (j digit))
|
||||
(if (> i (- n 1))
|
||||
j
|
||||
(loop (+ i 1) (+ j (* digit (expt base i)))))))))
|
||||
|
||||
;;; ── Mersenne + Lucas-Lehmer ──────────────────────────────────────
|
||||
|
||||
(define (mersenne-number p) (- (expt 2 p) 1))
|
||||
|
||||
;;; Lucas-Lehmer recurrence: s_0=4, s_{i+1} = s_i^2 - 2 (mod M_p).
|
||||
;;; Returns s_{p-2}. M_p is prime iff the residue is zero.
|
||||
(define (lucas-lehmer-residue p)
|
||||
(let ((m (mersenne-number p)))
|
||||
(let loop ((i 0) (s 4))
|
||||
(if (>= i (- p 2))
|
||||
s
|
||||
(loop (+ i 1) (modulo (- (* s s) 2) m))))))
|
||||
|
||||
(define (lucas-lehmer-primep p)
|
||||
(and (primep p)
|
||||
(zero? (lucas-lehmer-residue p))))
|
||||
|
||||
;;; ── digit conversion ─────────────────────────────────────────────
|
||||
;;; Zoë's CL version uses defgeneric/defmethod to dispatch on type
|
||||
;;; (integer → vector, vector → integer, sequence → integer via coerce).
|
||||
;;; In lumbda we dispatch by predicate — same behavior, no CLOS needed,
|
||||
;;; no new namespace to serialize. Portal stays clean.
|
||||
|
||||
(define (digits->integer seq base)
|
||||
(let* ((vec (if (vector? seq) seq (list->vector seq)))
|
||||
(len (vector-length vec)))
|
||||
(let loop ((i 0) (result 0))
|
||||
(if (>= i len)
|
||||
result
|
||||
(loop (+ i 1) (+ (* result base) (vector-ref vec i)))))))
|
||||
|
||||
(define (integer->digits number base)
|
||||
(cond ((< number base) (vector number))
|
||||
(else
|
||||
(let loop ((n number) (acc '()))
|
||||
(if (zero? n)
|
||||
(list->vector acc)
|
||||
(loop (quotient n base)
|
||||
(cons (modulo n base) acc)))))))
|
||||
|
||||
(define (digits number base)
|
||||
(cond ((integer? number) (integer->digits number base))
|
||||
((vector? number) (digits->integer number base))
|
||||
((list? number) (digits->integer number base))
|
||||
(else (error "digits: expected integer, vector, or list"))))
|
||||
|
||||
;;; ── random-n-bit integer primitives ──────────────────────────────
|
||||
|
||||
;;; Uniformly random integer with the top bit set — always in
|
||||
;;; [2^{n-1}, 2^n). Matches Zoë's CL `of-n-bits`.
|
||||
(define (of-n-bits n)
|
||||
(and (>= n 2)
|
||||
(let loop ((i (- n 2)) (sum (expt 2 (- n 1))))
|
||||
(if (< i 0)
|
||||
sum
|
||||
(loop (- i 1)
|
||||
(+ sum (* (random-int 2) (expt 2 i))))))))
|
||||
|
||||
;;; Rejection sample: draw random n-bit integers until one is prime.
|
||||
(define (prime-of-n-bits n)
|
||||
(and (>= n 2)
|
||||
(let try ()
|
||||
(let ((candidate (of-n-bits n)))
|
||||
(if (primep candidate) candidate (try))))))
|
||||
140
examples/ursa.lisp.txt
Normal file
140
examples/ursa.lisp.txt
Normal file
|
|
@ -0,0 +1,140 @@
|
|||
;;; ursa.lisp.txt — Zoë Trout's favorite programs.
|
||||
;;;
|
||||
;;; Canonical source: https://wedgewack.org/ursa.lisp.txt (Common Lisp).
|
||||
;;; This file preserves Zoë's CL — including iterative LOOP forms — and
|
||||
;;; loads into lumbda via the CL compatibility shim at cl-compat.lsp.
|
||||
;;;
|
||||
;;; Minimal edits from the canonical CL:
|
||||
;;; (load "cl-compat.lsp") — prepend to wire in defun/setf/loop/...
|
||||
;;; loop → cl-loop — plain `loop` is a reserved name we do
|
||||
;;; not shadow; cl-loop is the shim macro.
|
||||
;;; when → cl-when — plain `when` is a lumbda special form
|
||||
;;; returning #<void>; cl-when returns #f
|
||||
;;; so CL "nil on false" idioms compose.
|
||||
;;; random → random-int — lumbda RNG with portal-compatible state.
|
||||
;;; &key → &optional — keyword args not in the shim; positional.
|
||||
;;; rho / digits — two defuns omitted (they depend on
|
||||
;;; adjustable arrays + CLOS, out of scope
|
||||
;;; per ticket 0004). See ursa-scheme.lsp
|
||||
;;; for Scheme ports of both.
|
||||
;;;
|
||||
;;; Every LOOP form below is the ORIGINAL iterative style — no tail-
|
||||
;;; recursive rewrite required. After cl-compat loads, these run under
|
||||
;;; lumbda with TCO-preserving expansions (see ticket 0004 §C).
|
||||
;;;
|
||||
;;; See whitepaper §9.2 for the CL-in-Scheme rationale, and how this
|
||||
;;; file keeps Zoë's programs alive without stripping their iterative
|
||||
;;; shape.
|
||||
|
||||
(load "cl-compat.lsp")
|
||||
|
||||
(defun expt-mod (base exponent modulus)
|
||||
(declare (optimize (speed 3) (safety 1))
|
||||
(type integer base exponent modulus))
|
||||
(cond ((= modulus 1) 0)
|
||||
((= base 2) (mod (ash 1 exponent) modulus))
|
||||
(t (let ((b (mod base modulus))
|
||||
(e exponent)
|
||||
(acc 1))
|
||||
(declare (type integer b e acc))
|
||||
(cl-loop while (plusp e) do
|
||||
(cl-when (logbitp 0 e)
|
||||
(setf acc (mod (* acc b) modulus)))
|
||||
(setf b (mod (* b b) modulus)
|
||||
e (ash e -1)))
|
||||
acc))))
|
||||
|
||||
(defun miller-rabin-base (n a d s)
|
||||
(declare (optimize (speed 3) (safety 1))
|
||||
(type integer n a d s))
|
||||
(let ((x (expt-mod a d n)))
|
||||
(cond ((or (= x 1) (= x (1- n))) t)
|
||||
(t (cl-loop repeat s
|
||||
do (setf x (expt-mod x 2 n))
|
||||
when (= x (1- n)) return t
|
||||
finally (return nil))))))
|
||||
|
||||
(defun miller-rabin (n &optional (k 10))
|
||||
(declare (optimize (speed 3) (safety 1))
|
||||
(type integer n))
|
||||
(cond ((<= n 1) nil)
|
||||
((<= n 3) t)
|
||||
((evenp n) nil)
|
||||
(t (let ((d (1- n))
|
||||
(s 0))
|
||||
(cl-loop while (evenp d) do
|
||||
(setf d (ash d -1)
|
||||
s (1+ s)))
|
||||
(cl-loop repeat k
|
||||
for a = (+ 2 (random-int (- n 2)))
|
||||
unless (miller-rabin-base n a d s)
|
||||
return nil
|
||||
finally (return t))))))
|
||||
|
||||
(defun primep (n &optional (k 10))
|
||||
(declare (optimize (speed 3) (safety 1))
|
||||
(type integer n k))
|
||||
(cl-when (miller-rabin n k) n))
|
||||
|
||||
(defun rhoff (n)
|
||||
(declare (optimize (speed 3) (safety 1))
|
||||
(type (integer 2 *) n))
|
||||
(cond ((evenp n) 2)
|
||||
((primep n) n)
|
||||
(t
|
||||
(let ((c (1+ (random-int (1- n))))
|
||||
(x 2)
|
||||
(y 2)
|
||||
(d 1))
|
||||
(declare (type integer c x y d))
|
||||
(flet ((f (z)
|
||||
(declare (type integer z))
|
||||
(mod (+ (* z z) c) n)))
|
||||
(cl-loop while (= d 1) do
|
||||
(setf x (f x)
|
||||
y (f (f y))
|
||||
d (gcd (abs (- x y)) n))
|
||||
finally (return (and (< 1 d n) d))))))))
|
||||
|
||||
(defun repunit-value (n &optional (digit 1) (base 2))
|
||||
(declare (type (integer 2) base)
|
||||
(type (integer 1) digit)
|
||||
(optimize (speed 3) (safety 2)))
|
||||
(cl-when (> base digit)
|
||||
(cl-loop for i from 0 to (1- n)
|
||||
for j = digit then (+ j (* digit (expt base i)))
|
||||
finally (return j))))
|
||||
|
||||
(defun mersenne-number (p)
|
||||
(declare (type (integer 0 *) p)
|
||||
(optimize (speed 3) (safety 1)))
|
||||
(1- (ash 1 p)))
|
||||
|
||||
(defun lucas-lehmer-residue (p)
|
||||
(declare (type (integer 3 *) p)
|
||||
(optimize (speed 3) (safety 1)))
|
||||
(let ((m (mersenne-number p)))
|
||||
(cl-loop repeat (- p 1)
|
||||
for s of-type integer = 4 then (mod (- (* s s) 2) m)
|
||||
finally (return s))))
|
||||
|
||||
(defun lucas-lehmer-primep (p)
|
||||
(declare (type (integer 3 *) p)
|
||||
(optimize (speed 3) (safety 1)))
|
||||
(and (primep p)
|
||||
(zerop (lucas-lehmer-residue p))))
|
||||
|
||||
(defun of-n-bits (n)
|
||||
(declare (optimize (speed 3) (safety 1) (debug 0))
|
||||
(type integer n))
|
||||
(cl-when (>= n 2)
|
||||
(cl-loop for i from (1- n) downto 0
|
||||
for sum = (expt 2 i) then (+ sum (* (random-int 2) (expt 2 i)))
|
||||
finally (return sum))))
|
||||
|
||||
(defun prime-of-n-bits (n)
|
||||
(declare (optimize (speed 3) (safety 1) (debug 0))
|
||||
(type integer n))
|
||||
(cl-when (>= n 2)
|
||||
(cl-loop for i = (of-n-bits n)
|
||||
when (primep i) return i)))
|
||||
171
tests/cl-compat.lsp
Normal file
171
tests/cl-compat.lsp
Normal file
|
|
@ -0,0 +1,171 @@
|
|||
;; tests/cl-compat.lsp — exercises the CL compatibility shim.
|
||||
;; Runs in both Python and C via make test-zoe-favorites.
|
||||
(load "cl-compat.lsp")
|
||||
|
||||
(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))))
|
||||
|
||||
;; ── constants ────────────────────────────────────────────────────
|
||||
(check "t" t #t)
|
||||
(check "nil" nil #f)
|
||||
|
||||
;; ── predicates ───────────────────────────────────────────────────
|
||||
(check "evenp-4" (evenp 4) #t)
|
||||
(check "oddp-3" (oddp 3) #t)
|
||||
(check "plusp-5" (plusp 5) #t)
|
||||
(check "minusp-n" (minusp -5) #t)
|
||||
(check "zerop-0" (zerop 0) #t)
|
||||
|
||||
;; ── arithmetic ───────────────────────────────────────────────────
|
||||
(check "mod-10-3" (mod 10 3) 1)
|
||||
(check "ash-1-3" (ash 1 3) 8)
|
||||
(check "ash-8-n3" (ash 8 -3) 1)
|
||||
(check "ash-255-n4" (ash 255 -4) 15)
|
||||
|
||||
;; ── logbitp ──────────────────────────────────────────────────────
|
||||
(check "logbitp-0-6" (logbitp 0 6) #f)
|
||||
(check "logbitp-1-6" (logbitp 1 6) #t)
|
||||
(check "logbitp-2-6" (logbitp 2 6) #t)
|
||||
(check "logbitp-3-6" (logbitp 3 6) #f)
|
||||
|
||||
;; ── list ops ─────────────────────────────────────────────────────
|
||||
(check "nreverse" (nreverse (list 1 2 3)) '(3 2 1))
|
||||
|
||||
;; ── cl-when / cl-unless ──────────────────────────────────────────
|
||||
(check "cl-when-t" (cl-when #t 1 2 3) 3)
|
||||
(check "cl-when-f" (cl-when #f 1 2 3) #f)
|
||||
(check "cl-unless-t" (cl-unless #t 1 2 3) #f)
|
||||
(check "cl-unless-f" (cl-unless #f 1 2 3) 3)
|
||||
|
||||
;; ── defun ────────────────────────────────────────────────────────
|
||||
(defun square-it (x) (* x x))
|
||||
(check "defun-basic" (square-it 7) 49)
|
||||
|
||||
(defun greet (who &optional (greeting "hello"))
|
||||
(list greeting who))
|
||||
(check "defun-opt-default" (greet 'world) '("hello" world))
|
||||
(check "defun-opt-provided" (greet 'world "bonjour") '("bonjour" world))
|
||||
|
||||
(defun maybe (x &optional y)
|
||||
(if (null? y) 'no-y (list x y)))
|
||||
(check "defun-opt-nil" (maybe 1) 'no-y)
|
||||
(check "defun-opt-given" (maybe 1 2) '(1 2))
|
||||
|
||||
;; ── setf ─────────────────────────────────────────────────────────
|
||||
(define x 10)
|
||||
(setf x 20)
|
||||
(check "setf-single" x 20)
|
||||
|
||||
(define a 1) (define b 2) (define c 3)
|
||||
(setf a 100 b 200 c 300)
|
||||
(check "setf-multi-a" a 100)
|
||||
(check "setf-multi-b" b 200)
|
||||
(check "setf-multi-c" c 300)
|
||||
|
||||
;; ── flet ─────────────────────────────────────────────────────────
|
||||
(check "flet"
|
||||
(flet ((double (n) (* 2 n))
|
||||
(triple (n) (* 3 n)))
|
||||
(+ (double 5) (triple 5)))
|
||||
25)
|
||||
|
||||
;; ── multiple-value-bind ──────────────────────────────────────────
|
||||
(check "mvb"
|
||||
(multiple-value-bind (q r) (values 7 3) (list q r))
|
||||
'(7 3))
|
||||
|
||||
;; ── cl-loop: 14 representative patterns ─────────────────────────
|
||||
|
||||
;; 1. while + do
|
||||
(define counter 0)
|
||||
(cl-loop while (< counter 5) do (setf counter (+ counter 1)))
|
||||
(check "loop-while-do" counter 5)
|
||||
|
||||
;; 2. while + multi-setf
|
||||
(define d 16) (define s 0)
|
||||
(cl-loop while (evenp d) do (setf d (ash d -1) s (1+ s)))
|
||||
(check "loop-while-multi-d" d 1)
|
||||
(check "loop-while-multi-s" s 4)
|
||||
|
||||
;; 3. while + finally return
|
||||
(define u 10)
|
||||
(check "loop-while-finally"
|
||||
(cl-loop while (> u 0) do (setf u (- u 1)) finally (return u))
|
||||
0)
|
||||
|
||||
;; 4. repeat + simple-for + unless return + finally
|
||||
(check "loop-repeat-simple-unless"
|
||||
(cl-loop repeat 5 for av = 3 unless (> av 0) return 'early finally (return 'done))
|
||||
'done)
|
||||
|
||||
;; 5. repeat + when return
|
||||
(check "loop-repeat-when-return"
|
||||
(let ((k 0))
|
||||
(cl-loop repeat 10 do (setf k (+ k 1))
|
||||
when (= k 3) return 'got-three
|
||||
finally (return 'not-hit)))
|
||||
'got-three)
|
||||
|
||||
;; 6. repeat + then accumulator + finally
|
||||
(check "loop-repeat-then"
|
||||
(cl-loop repeat 4 for sv of-type integer = 4 then (- (* sv sv) 2) finally (return sv))
|
||||
37634)
|
||||
|
||||
;; 7. range to + then accumulator
|
||||
(check "loop-range-to-then"
|
||||
(cl-loop for i from 0 to 4 for j = 1 then (+ j (expt 2 i)) finally (return j))
|
||||
31)
|
||||
|
||||
;; 8. range below + do
|
||||
(define acc '())
|
||||
(cl-loop for i from 0 below 5 do (set! acc (cons i acc)))
|
||||
(check "loop-range-below" (reverse acc) '(0 1 2 3 4))
|
||||
|
||||
;; 9. range downto + then accumulator
|
||||
(check "loop-range-downto-then"
|
||||
(cl-loop for i from 4 downto 0 for sum = (expt 2 i) then (+ sum (expt 2 i)) finally (return sum))
|
||||
31)
|
||||
|
||||
;; 10. with + across + finally
|
||||
(check "loop-with-across"
|
||||
(cl-loop with result = 0 for digit across (vector 1 2 3 4 5)
|
||||
do (setf result (+ (* result 10) digit))
|
||||
finally (return result))
|
||||
12345)
|
||||
|
||||
;; 11. simple-for (infinite) + when return
|
||||
(check "loop-infinite-when"
|
||||
(let ((gen 0))
|
||||
(cl-loop for i = (begin (set! gen (+ gen 1)) gen)
|
||||
when (> i 3) return i))
|
||||
4)
|
||||
|
||||
;; 12. simple-for + until + finally (body variant)
|
||||
(check "loop-simple-until-finally-body"
|
||||
(let ((found 0))
|
||||
(cl-loop for dv = (if (= found 0) #f 42)
|
||||
until dv
|
||||
do (set! found 1)
|
||||
finally (set! found (+ found 100)))
|
||||
found)
|
||||
101)
|
||||
|
||||
;; 13. declare (no-op) inside defun
|
||||
(defun decl-fn (x)
|
||||
(declare (optimize (speed 3)) (type integer x))
|
||||
(* x x))
|
||||
(check "declare-noop" (decl-fn 9) 81)
|
||||
|
||||
(display "══════════════════════════════") (newline)
|
||||
(display "cl-compat: ") (display *pass*) (display " passed, ")
|
||||
(display *fail*) (display " failed") (newline)
|
||||
(if (> *fail* 0) (exit 1))
|
||||
70
tests/ursa.lsp
Normal file
70
tests/ursa.lsp
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
;; 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))
|
||||
38
tests/zoe-favorites-test.sh
Executable file
38
tests/zoe-favorites-test.sh
Executable file
|
|
@ -0,0 +1,38 @@
|
|||
#!/bin/bash
|
||||
# tests/zoe-favorites-test.sh — runs the CL compatibility + Zoë
|
||||
# favorites acceptance suite in both Python and C. See ticket 0004
|
||||
# and whitepaper §9.2.
|
||||
|
||||
set -e
|
||||
ulimit -v 524288
|
||||
cd "$(dirname "$0")/.."
|
||||
trap 'pkill -9 -u "$USER" -f "c/lumbda" 2>/dev/null || true' EXIT INT TERM
|
||||
|
||||
echo "═══════════════════════════════════════════════════════"
|
||||
echo "Zoë Trout's favorites — CL compat + Scheme ports"
|
||||
echo "═══════════════════════════════════════════════════════"
|
||||
|
||||
FAIL=0
|
||||
run_one() {
|
||||
local impl="$1" cmd="$2" input="$3"
|
||||
echo ""
|
||||
echo "── $impl: $input ──"
|
||||
if ! timeout 30 $cmd "$input"; then
|
||||
FAIL=1
|
||||
fi
|
||||
}
|
||||
|
||||
run_one "Python" "python3 lumbda.py" "tests/cl-compat.lsp"
|
||||
run_one "C" "c/lumbda" "tests/cl-compat.lsp"
|
||||
run_one "Python" "python3 lumbda.py" "tests/ursa.lsp"
|
||||
run_one "C" "c/lumbda" "tests/ursa.lsp"
|
||||
|
||||
echo ""
|
||||
echo "═══════════════════════════════════════════════════════"
|
||||
if [ $FAIL -eq 0 ]; then
|
||||
echo "All Zoë-favorites tests passed (Python + C)"
|
||||
else
|
||||
echo "SOME TESTS FAILED"
|
||||
fi
|
||||
echo "═══════════════════════════════════════════════════════"
|
||||
exit $FAIL
|
||||
|
|
@ -925,7 +925,7 @@ main img, section img {
|
|||
</figure>
|
||||
<p class="center"><strong>A Lisp/Scheme-derived, just-in-time lambda language. Four implementation tiers with MOAD defect isolation. Workloads migrate across basic UNIX systems.</strong></p>
|
||||
<p class="center"><em>Feedback is all you need: continuations within a process, portals across processes, S-expressions across implementations, sockets across machines.</em></p>
|
||||
<p class="center"><em>russell@unturf, TimeHexOn, foxhop</em></p>
|
||||
<p class="center"><em>russell@unturf, TimeHexOn, foxhop, Zoë Trout</em></p>
|
||||
<p class="center"><a class="reference external" href="https://lumbda.com">lumbda.com</a> · <a class="reference external" href="https://uncloseai.com">uncloseai.com</a> · <a class="reference external" href="https://www.permacomputer.com">permacomputer.com</a></p>
|
||||
<p class="center"><em>April 2026</em></p>
|
||||
<hr class="docutils" />
|
||||
|
|
@ -2166,6 +2166,19 @@ ALL EML THEOREMS VERIFIED IN LUMBDA</pre>
|
|||
<p><strong>Domain limits.</strong> Python: unbounded — works on arbitrary-precision <span class="docutils literal">int</span>. asm: 61-bit (three tag bits consumed at the bottom of the word). C: 48-bit (NaN-boxed doubles carry the integer payload in the mantissa). Portal round-trips remain bit-identical within the smaller of the two tiers on either end; a value that fits in the C tier's 48-bit window survives every Python ↔ C ↔ asm crossing in §7.2's 3×3 matrix.</p>
|
||||
<p><strong>MOAD-0001 note.</strong> Each call is O(log n) in the value, not in the heap or the symbol table. No hidden linear scan, no per-call allocation in C or asm. Safe to invoke inside a tight loop without inflating the overall complexity class.</p>
|
||||
</section>
|
||||
<section id="common-lisp-compatibility-zoe-s-favorites">
|
||||
<h3>9.2 Common Lisp Compatibility: Zoë's Favorites</h3>
|
||||
<p>Scheme and Common Lisp take opposite stances on iteration. Scheme iterates through tail-recursion; CL iterates through its <span class="docutils literal">loop</span> macro, <span class="docutils literal">setf</span>, and an image-based development culture where processes outlive the developer's attention by days or months. Zoë Trout asked the question that frames this section: <em>do we care for our programs, and how long are they alive for?</em> Her favorite programs at <a class="reference external" href="https://wedgewack.org/ursa.lisp.txt">wedgewack.org/ursa.lisp.txt</a> — modular exponentiation, Miller-Rabin primality, Pollard rho factorization, Lucas-Lehmer Mersenne testing, digit-vector round-trips, random prime generation — carry the CL iterative DNA. They were written to be read and modified inside a stone-lisp image, not rewritten as tail recursion by a porting tool.</p>
|
||||
<p>Ticket <span class="docutils literal"><span class="pre">docs/tickets/0004-cl-compat.md</span></span> answers in two layers: <em>(a)</em> idiomatic Scheme ports (<span class="docutils literal"><span class="pre">examples/ursa-scheme.lsp</span></span>) for readers who prefer named-let and tail recursion, and <em>(b)</em> a compatibility shim (<span class="docutils literal"><span class="pre">cl-compat.lsp</span></span>) plus a <span class="docutils literal"><span class="pre">cl-loop</span></span> macro that runs Zoë's original CL source — minimally annotated — on lumbda without rewriting its iterative shape.</p>
|
||||
<p><strong>What the shim covers.</strong> <span class="docutils literal">defun</span> with <span class="docutils literal">&optional</span>, <span class="docutils literal">setf</span> on simple variables (multi-pair), <span class="docutils literal">flet</span>, <span class="docutils literal"><span class="pre">multiple-value-bind</span></span>, <span class="docutils literal">t</span> and <span class="docutils literal">nil</span> (nil bound to <span class="docutils literal">#f</span> — CL code overwhelmingly uses nil as false), the <span class="docutils literal"><span class="pre">-p</span></span> predicates (<span class="docutils literal">evenp</span>, <span class="docutils literal">oddp</span>, <span class="docutils literal">plusp</span>, <span class="docutils literal">minusp</span>, <span class="docutils literal">zerop</span>), bit and integer ops (<span class="docutils literal">mod</span>, <span class="docutils literal">ash</span>, <span class="docutils literal">logbitp</span>, <span class="docutils literal">nreverse</span>), <span class="docutils literal">declare</span> forms as no-ops, and <span class="docutils literal"><span class="pre">cl-when</span></span> / <span class="docutils literal"><span class="pre">cl-unless</span></span> with CL-style return-nil-on-false semantics (plain <span class="docutils literal">when</span> / <span class="docutils literal">unless</span> are lumbda special forms that return <span class="docutils literal">#<void></span> — which Scheme treats as truthy — so a prefixed name opts into CL semantics without shadowing the core).</p>
|
||||
<p><strong>cl-loop.</strong> A <span class="docutils literal"><span class="pre">define-macro</span></span> over the 14 clause shapes used in Zoë's source: <span class="docutils literal">with VAR = INIT</span>, <span class="docutils literal">for VAR from A [to | below | downto] B</span>, <span class="docutils literal">for VAR = INIT [then STEP]</span>, <span class="docutils literal">for VAR across VEC</span>, <span class="docutils literal"><span class="pre">of-type</span> T</span> hints, <span class="docutils literal">while</span> / <span class="docutils literal">until</span> / <span class="docutils literal">repeat</span>, <span class="docutils literal">do EXPR ...</span>, <span class="docutils literal">when TEST return VAL</span>, <span class="docutils literal">unless TEST return VAL</span>, <span class="docutils literal">finally (return VAL)</span> and <span class="docutils literal">finally BODY</span>. Every expansion lands in a named-let tail call, so TCO keeps the stack flat for loops of any length.</p>
|
||||
<p>Stepping is <span class="docutils literal">do*</span>-sequential: each iteration variable's step form sees NEW values of earlier-declared variables. This matters for Zoë's <span class="docutils literal">(loop for i from 4 downto 0 for sum = (expt 2 i) then (+ sum (* (random 2) (expt 2 <span class="pre">i))))</span></span> — sum's step uses the just-decremented i, yielding a uniform random n-bit integer with the top bit set. The macro implements sequential stepping by gensyming new-names for each state variable and using <span class="docutils literal"><span class="pre">cl-subst</span></span> to rename earlier-vars inside each step form before emitting the recursive call.</p>
|
||||
<p>Termination is split into two phases to match CL semantics exactly. <span class="docutils literal">while</span> and <span class="docutils literal">until</span> are pre-body checks on current state. <span class="docutils literal">repeat</span> and <span class="docutils literal"><span class="pre">for-range</span></span> are look-ahead checks on stepped state: after the body runs, we compute new values into fresh gensym bindings, check termination against those, and if any fires we run the finalizer with the CURRENT (unstepped) state variables still in scope from the outer named-let. This mirrors CL's "would step past the limit" rule and matters for a loop like <span class="docutils literal">(loop repeat 4 for s <span class="pre">of-type</span> integer = 4 then (- (* s s) 2) finally (return s))</span> — the finalizer returns <span class="docutils literal"><span class="pre">s_{p-2}</span> = 37634</span> after four body-runs and three step-forms, not <span class="docutils literal"><span class="pre">s_{p-1}</span> = 1416317954</span> after four step-forms.</p>
|
||||
<p><strong>Guarantees that survive.</strong> Every shim is syntactic sugar over the same functional core the rest of this paper describes. <span class="docutils literal">defun</span> expands to <span class="docutils literal">define</span>. <span class="docutils literal">setf</span> on a simple variable expands to <span class="docutils literal">set!</span> — a capability lumbda already carries. <span class="docutils literal">flet</span> expands to <span class="docutils literal">let</span> + <span class="docutils literal">lambda</span>. <span class="docutils literal"><span class="pre">cl-loop</span></span> expands to <span class="docutils literal">let*</span> + named-let + <span class="docutils literal">cond</span> + tail-recursive calls. Portal determinism and cross-implementation reproducibility both hold: the shim is pure Scheme, loads identically in Python and C, and introduces no new mutable types — Zoë's <span class="docutils literal">rho</span> work-queue would require an adjustable vector, so the Scheme port uses a list-backed stack and the CL version omits that defun (see ticket 0004 for the scope boundary).</p>
|
||||
<p><strong>A defect uncovered along the way.</strong> Building <span class="docutils literal"><span class="pre">cl-loop</span></span> surfaced a real flaw in lumbda's C tree-walker. <span class="docutils literal">env_lookup</span> in <span class="docutils literal">c/types.c</span> had a "global shortcut": after missing in the local frame, it checked the global environment directly, skipping intermediate parent scopes entirely. For code like <span class="docutils literal">(define s 4) (let ((s 100)) (let ((m 0)) s))</span>, the inner let's body resolved <span class="docutils literal">s</span> to the global <span class="docutils literal">4</span> instead of the shadowed <span class="docutils literal">100</span>, because the shortcut fired before the parent chain was walked. Any code that shadowed a global inside a <span class="docutils literal">let</span>, then opened another <span class="docutils literal">let</span> whose body referenced the shadowed name, silently read the global. Under stone-lisp style — where global bindings carry across REPL restarts and shadowing is routine — this defect waited for years inside C's path. <span class="docutils literal"><span class="pre">cl-loop</span></span> triggered it because iterators often share names with globals accumulated over an image's lifetime. Fix: walk the parent chain end-to-end. <span class="docutils literal">1255</span> assertions across five suites pass unchanged after the fix.</p>
|
||||
<p><strong>Tests.</strong> <span class="docutils literal"><span class="pre">tests/cl-compat.lsp</span></span> (44 assertions) and <span class="docutils literal">tests/ursa.lsp</span> (28 assertions) run under both Python and C via <span class="docutils literal"><span class="pre">tests/zoe-favorites-test.sh</span></span>, wired into <span class="docutils literal">make <span class="pre">test-all</span></span>. Zoë's original CL file (<span class="docutils literal">examples/ursa.lisp.txt</span>, minimally annotated — see its header for the exact edits) and the Scheme port (<span class="docutils literal"><span class="pre">examples/ursa-scheme.lsp</span></span>) produce matching answers on every test input.</p>
|
||||
<p>A process, once alive, should be allowed to stay alive. The iterative style that keeps a CL image alive across decades is not an obstacle to Scheme's guarantees — after macroexpansion, it <em>is</em> Scheme, it <em>is</em> tail-recursive, and it <em>does</em> portal-save the same way as everything else in this paper.</p>
|
||||
</section>
|
||||
</section>
|
||||
<section id="relationship-to-companion-papers">
|
||||
<h2>10. Relationship to Companion Papers</h2>
|
||||
|
|
@ -2719,11 +2732,11 @@ client port</p></td>
|
|||
</section>
|
||||
<section id="acknowledgments">
|
||||
<h2>Acknowledgments</h2>
|
||||
<p><strong>Zoë Trout</strong> — for the question that surfaced a gap we had not noticed: <em>does the portal tech keep the random list seed which will allow transferring random entropy between processes when continuing a simulation?</em> The answer before Zoë asked was "no, because Lumbda had no RNG." The answer after (§7.5) is "yes, bit-identical across Python, C, and asm." A research contribution delivered as a single question.</p>
|
||||
<p><strong>Zoë Trout</strong> — co-author of this work. fox would not have started down this path without a Lisp user's help. Her first contribution was a question most systems people never think to ask: <em>do we care for our programs, and how long are they alive for?</em> Common Lisp culture — stone-lisp, image-based development — produces processes that outlive the developer's attention by days, months, sometimes years, and killing them is almost never on purpose. From that question everything else followed. <em>Did the portal keep the random list seed so entropy could transfer between processes when continuing a simulation?</em> — that was a derivative, a specific instance of the deeper concern. §7.5 answered the RNG half (bit-identical across Python, C, and asm). §9.2 answers the iteration half — her favorite programs (modular exponentiation, Miller-Rabin, Pollard rho, Lucas-Lehmer, digit conversion) shaped a CL shim and <cite>loop</cite> macro that let lumbda host iterative code without rewriting it as tail recursion. A process, once alive, should be allowed to stay alive.</p>
|
||||
</section>
|
||||
<section id="citation">
|
||||
<h2>Citation</h2>
|
||||
<pre class="literal-block">russell@unturf, TimeHexOn, foxhop. "Feedback Is All You Need."
|
||||
<pre class="literal-block">russell@unturf, TimeHexOn, foxhop, Zoë Trout. "Feedback Is All You Need."
|
||||
permacomputer.com, 2026.
|
||||
https://lumbda.com/lumbda-whitepaper.pdf</pre>
|
||||
</section>
|
||||
|
|
@ -2774,7 +2787,7 @@ permacomputer monitoring itself, repairing itself, with minimal human in the
|
|||
loop guidance. Our machine learning agents do their best to leave no stone
|
||||
unturned.
|
||||
|
||||
Copyright (C) 2025-2026 TimeHexOn & foxhop & russell@unturf
|
||||
Copyright (C) 2025-2026 TimeHexOn & foxhop & russell@unturf & Zoë Trout
|
||||
https://www.timehexon.com
|
||||
https://www.foxhop.net
|
||||
https://www.unturf.com/software
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -41,7 +41,7 @@ lumbda.
|
|||
|
||||
.. class:: center
|
||||
|
||||
*russell@unturf, TimeHexOn, foxhop*
|
||||
*russell@unturf, TimeHexOn, foxhop, Zoë Trout*
|
||||
|
||||
.. class:: center
|
||||
|
||||
|
|
@ -1088,6 +1088,30 @@ Lumbda implements a near-complete R7RS-small Scheme:
|
|||
**MOAD-0001 note.** Each call is O(log n) in the value, not in the heap or the symbol table. No hidden linear scan, no per-call allocation in C or asm. Safe to invoke inside a tight loop without inflating the overall complexity class.
|
||||
|
||||
|
||||
9.2 Common Lisp Compatibility: Zoë's Favorites
|
||||
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||
|
||||
Scheme and Common Lisp take opposite stances on iteration. Scheme iterates through tail-recursion; CL iterates through its ``loop`` macro, ``setf``, and an image-based development culture where processes outlive the developer's attention by days or months. Zoë Trout asked the question that frames this section: *do we care for our programs, and how long are they alive for?* Her favorite programs at `wedgewack.org/ursa.lisp.txt <https://wedgewack.org/ursa.lisp.txt>`_ — modular exponentiation, Miller-Rabin primality, Pollard rho factorization, Lucas-Lehmer Mersenne testing, digit-vector round-trips, random prime generation — carry the CL iterative DNA. They were written to be read and modified inside a stone-lisp image, not rewritten as tail recursion by a porting tool.
|
||||
|
||||
Ticket ``docs/tickets/0004-cl-compat.md`` answers in two layers: *(a)* idiomatic Scheme ports (``examples/ursa-scheme.lsp``) for readers who prefer named-let and tail recursion, and *(b)* a compatibility shim (``cl-compat.lsp``) plus a ``cl-loop`` macro that runs Zoë's original CL source — minimally annotated — on lumbda without rewriting its iterative shape.
|
||||
|
||||
**What the shim covers.** ``defun`` with ``&optional``, ``setf`` on simple variables (multi-pair), ``flet``, ``multiple-value-bind``, ``t`` and ``nil`` (nil bound to ``#f`` — CL code overwhelmingly uses nil as false), the ``-p`` predicates (``evenp``, ``oddp``, ``plusp``, ``minusp``, ``zerop``), bit and integer ops (``mod``, ``ash``, ``logbitp``, ``nreverse``), ``declare`` forms as no-ops, and ``cl-when`` / ``cl-unless`` with CL-style return-nil-on-false semantics (plain ``when`` / ``unless`` are lumbda special forms that return ``#<void>`` — which Scheme treats as truthy — so a prefixed name opts into CL semantics without shadowing the core).
|
||||
|
||||
**cl-loop.** A ``define-macro`` over the 14 clause shapes used in Zoë's source: ``with VAR = INIT``, ``for VAR from A [to | below | downto] B``, ``for VAR = INIT [then STEP]``, ``for VAR across VEC``, ``of-type T`` hints, ``while`` / ``until`` / ``repeat``, ``do EXPR ...``, ``when TEST return VAL``, ``unless TEST return VAL``, ``finally (return VAL)`` and ``finally BODY``. Every expansion lands in a named-let tail call, so TCO keeps the stack flat for loops of any length.
|
||||
|
||||
Stepping is ``do*``-sequential: each iteration variable's step form sees NEW values of earlier-declared variables. This matters for Zoë's ``(loop for i from 4 downto 0 for sum = (expt 2 i) then (+ sum (* (random 2) (expt 2 i))))`` — sum's step uses the just-decremented i, yielding a uniform random n-bit integer with the top bit set. The macro implements sequential stepping by gensyming new-names for each state variable and using ``cl-subst`` to rename earlier-vars inside each step form before emitting the recursive call.
|
||||
|
||||
Termination is split into two phases to match CL semantics exactly. ``while`` and ``until`` are pre-body checks on current state. ``repeat`` and ``for-range`` are look-ahead checks on stepped state: after the body runs, we compute new values into fresh gensym bindings, check termination against those, and if any fires we run the finalizer with the CURRENT (unstepped) state variables still in scope from the outer named-let. This mirrors CL's "would step past the limit" rule and matters for a loop like ``(loop repeat 4 for s of-type integer = 4 then (- (* s s) 2) finally (return s))`` — the finalizer returns ``s_{p-2} = 37634`` after four body-runs and three step-forms, not ``s_{p-1} = 1416317954`` after four step-forms.
|
||||
|
||||
**Guarantees that survive.** Every shim is syntactic sugar over the same functional core the rest of this paper describes. ``defun`` expands to ``define``. ``setf`` on a simple variable expands to ``set!`` — a capability lumbda already carries. ``flet`` expands to ``let`` + ``lambda``. ``cl-loop`` expands to ``let*`` + named-let + ``cond`` + tail-recursive calls. Portal determinism and cross-implementation reproducibility both hold: the shim is pure Scheme, loads identically in Python and C, and introduces no new mutable types — Zoë's ``rho`` work-queue would require an adjustable vector, so the Scheme port uses a list-backed stack and the CL version omits that defun (see ticket 0004 for the scope boundary).
|
||||
|
||||
**A defect uncovered along the way.** Building ``cl-loop`` surfaced a real flaw in lumbda's C tree-walker. ``env_lookup`` in ``c/types.c`` had a "global shortcut": after missing in the local frame, it checked the global environment directly, skipping intermediate parent scopes entirely. For code like ``(define s 4) (let ((s 100)) (let ((m 0)) s))``, the inner let's body resolved ``s`` to the global ``4`` instead of the shadowed ``100``, because the shortcut fired before the parent chain was walked. Any code that shadowed a global inside a ``let``, then opened another ``let`` whose body referenced the shadowed name, silently read the global. Under stone-lisp style — where global bindings carry across REPL restarts and shadowing is routine — this defect waited for years inside C's path. ``cl-loop`` triggered it because iterators often share names with globals accumulated over an image's lifetime. Fix: walk the parent chain end-to-end. ``1255`` assertions across five suites pass unchanged after the fix.
|
||||
|
||||
**Tests.** ``tests/cl-compat.lsp`` (44 assertions) and ``tests/ursa.lsp`` (28 assertions) run under both Python and C via ``tests/zoe-favorites-test.sh``, wired into ``make test-all``. Zoë's original CL file (``examples/ursa.lisp.txt``, minimally annotated — see its header for the exact edits) and the Scheme port (``examples/ursa-scheme.lsp``) produce matching answers on every test input.
|
||||
|
||||
A process, once alive, should be allowed to stay alive. The iterative style that keeps a CL image alive across decades is not an obstacle to Scheme's guarantees — after macroexpansion, it *is* Scheme, it *is* tail-recursive, and it *does* portal-save the same way as everything else in this paper.
|
||||
|
||||
|
||||
10. Relationship to Companion Papers
|
||||
--------------------------------------
|
||||
|
||||
|
|
@ -1501,7 +1525,7 @@ This paper is the proof. The commit history is the evidence. The fix starts with
|
|||
Acknowledgments
|
||||
---------------
|
||||
|
||||
**Zoë Trout** — for the question that surfaced a gap we had not noticed: *does the portal tech keep the random list seed which will allow transferring random entropy between processes when continuing a simulation?* The answer before Zoë asked was "no, because Lumbda had no RNG." The answer after (§7.5) is "yes, bit-identical across Python, C, and asm." A research contribution delivered as a single question.
|
||||
**Zoë Trout** — co-author of this work. fox would not have started down this path without a Lisp user's help. Her first contribution was a question most systems people never think to ask: *do we care for our programs, and how long are they alive for?* Common Lisp culture — stone-lisp, image-based development — produces processes that outlive the developer's attention by days, months, sometimes years, and killing them is almost never on purpose. From that question everything else followed. *Did the portal keep the random list seed so entropy could transfer between processes when continuing a simulation?* — that was a derivative, a specific instance of the deeper concern. §7.5 answered the RNG half (bit-identical across Python, C, and asm). §9.2 answers the iteration half — her favorite programs (modular exponentiation, Miller-Rabin, Pollard rho, Lucas-Lehmer, digit conversion) shaped a CL shim and `loop` macro that let lumbda host iterative code without rewriting it as tail recursion. A process, once alive, should be allowed to stay alive.
|
||||
|
||||
|
||||
Citation
|
||||
|
|
@ -1509,7 +1533,7 @@ Citation
|
|||
|
||||
::
|
||||
|
||||
russell@unturf, TimeHexOn, foxhop. "Feedback Is All You Need."
|
||||
russell@unturf, TimeHexOn, foxhop, Zoë Trout. "Feedback Is All You Need."
|
||||
permacomputer.com, 2026.
|
||||
https://lumbda.com/lumbda-whitepaper.pdf
|
||||
|
||||
|
|
@ -1573,7 +1597,7 @@ License
|
|||
loop guidance. Our machine learning agents do their best to leave no stone
|
||||
unturned.
|
||||
|
||||
Copyright (C) 2025-2026 TimeHexOn & foxhop & russell@unturf
|
||||
Copyright (C) 2025-2026 TimeHexOn & foxhop & russell@unturf & Zoë Trout
|
||||
https://www.timehexon.com
|
||||
https://www.foxhop.net
|
||||
https://www.unturf.com/software
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue