scheme: Phase 3 — if/define/set!/begin/lambda/closures + 24 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s

eval.sx grows: five new syntactic operators wired via the table-
driven dispatch from Phase 2. lambda creates closures
{:scm-tag :closure :params :rest :body :env} that capture the
static env; scheme-apply-closure binds formals + rest-arg, evaluates
multi-expression body in (extend static-env), returns last value.

Supports lambda formals shapes:
  ()            → no args
  (a b c)       → fixed arity
  args          → bare symbol; binds all call-args as a list

Dotted-pair tail (a b . rest) deferred until parser supports it.

define has both flavours:
  (define name expr)                 — direct binding
  (define (name . formals) body...)  — lambda sugar

set! walks the env chain via refl-env-find-frame, mutates at the
binding's source frame (no shadowing). Raises on unbound name.

24 new tests in lib/scheme/tests/syntax.sx, including:
- Factorial 5 → 120 and 10 → 3628800 (recursion + closures)
- make-counter via closed-over set! state
- Curried (((curry+ 1) 2) 3) → 6
- (lambda args args) rest-arg binding
- Multi-body lambdas with internal define

109 total Scheme tests (62 parse + 23 eval + 24 syntax).
This commit is contained in:
2026-05-13 20:02:46 +00:00
parent e222e8b0aa
commit 23a53a2ccb
2 changed files with 386 additions and 4 deletions

237
lib/scheme/tests/syntax.sx Normal file
View File

@@ -0,0 +1,237 @@
;; lib/scheme/tests/syntax.sx — exercises Phase 3 syntactic operators.
(define scm-syn-pass 0)
(define scm-syn-fail 0)
(define scm-syn-fails (list))
(define
scm-syn-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-syn-pass (+ scm-syn-pass 1))
(begin
(set! scm-syn-fail (+ scm-syn-fail 1))
(append! scm-syn-fails {:name name :actual actual :expected expected})))))
(define scm-syn-eval (fn (src env) (scheme-eval (scheme-parse src) env)))
(define
scm-syn-eval-all
(fn (src env) (scheme-eval-program (scheme-parse-all src) env)))
;; Test env with arithmetic primitives.
(define
scm-syn-env
(fn
()
(let
((env (scheme-make-env)))
(scheme-env-bind!
env
"+"
(fn (args) (+ (first args) (nth args 1))))
(scheme-env-bind!
env
"-"
(fn (args) (- (first args) (nth args 1))))
(scheme-env-bind!
env
"*"
(fn (args) (* (first args) (nth args 1))))
(scheme-env-bind!
env
"/"
(fn (args) (/ (first args) (nth args 1))))
(scheme-env-bind!
env
"<="
(fn (args) (<= (first args) (nth args 1))))
(scheme-env-bind!
env
"<"
(fn (args) (< (first args) (nth args 1))))
(scheme-env-bind!
env
"="
(fn (args) (= (first args) (nth args 1))))
(scheme-env-bind! env "list" (fn (args) args))
(scheme-env-bind!
env
"cons"
(fn (args) (cons (first args) (nth args 1))))
(scheme-env-bind! env "car" (fn (args) (first (first args))))
(scheme-env-bind! env "cdr" (fn (args) (rest (first args))))
env)))
;; ── if ───────────────────────────────────────────────────────────
(scm-syn-test
"if: true"
(scm-syn-eval "(if #t 1 2)" (scm-syn-env))
1)
(scm-syn-test
"if: false"
(scm-syn-eval "(if #f 1 2)" (scm-syn-env))
2)
(scm-syn-test
"if: predicate"
(scm-syn-eval "(if (<= 1 2) 99 nope)" (scm-syn-env))
99)
(scm-syn-test
"if: no else returns nil"
(scm-syn-eval "(if #f 99)" (scm-syn-env))
nil)
(scm-syn-test
"if: truthy non-#f"
(scm-syn-eval "(if 0 'yes 'no)" (scm-syn-env))
"yes")
;; ── define ───────────────────────────────────────────────────────
(scm-syn-test
"define: bind value"
(let
((env (scm-syn-env)))
(scm-syn-eval "(define x 42)" env)
(scm-syn-eval "x" env))
42)
(scm-syn-test
"define: function sugar"
(let
((env (scm-syn-env)))
(scm-syn-eval-all "(define (double n) (+ n n)) (double 21)" env))
42)
(scm-syn-test
"define: redefine"
(let
((env (scm-syn-env)))
(scm-syn-eval-all "(define x 1) (define x 2) x" env))
2)
;; ── set! ─────────────────────────────────────────────────────────
(scm-syn-test
"set!: mutate"
(let
((env (scm-syn-env)))
(scm-syn-eval-all "(define x 1) (set! x 99) x" env))
99)
(scm-syn-test
"set!: walks parent"
(let
((env (scm-syn-env)))
(scm-syn-eval-all "(define x 1) ((lambda () (set! x 100))) x" env))
100)
(scm-syn-test
"set!: errors on unbound"
(guard
(e (true :raised))
(scm-syn-eval-all "(set! never-defined 1)" (scm-syn-env)))
:raised)
;; ── begin ────────────────────────────────────────────────────────
(scm-syn-test
"begin: empty returns nil"
(scm-syn-eval "(begin)" (scm-syn-env))
nil)
(scm-syn-test
"begin: returns last"
(scm-syn-eval "(begin 1 2 3)" (scm-syn-env))
3)
(scm-syn-test
"begin: side effects in order"
(let
((env (scm-syn-env)))
(scm-syn-eval-all
"(define x 0) (begin (set! x 1) (set! x 2) (set! x 3)) x"
env))
3)
;; ── lambda ───────────────────────────────────────────────────────
(scm-syn-test
"lambda: identity"
(scm-syn-eval "((lambda (x) x) 42)" (scm-syn-env))
42)
(scm-syn-test
"lambda: arithmetic"
(scm-syn-eval "((lambda (x y) (+ x y)) 3 4)" (scm-syn-env))
7)
(scm-syn-test
"lambda: zero args"
(scm-syn-eval "((lambda () 99))" (scm-syn-env))
99)
(scm-syn-test
"lambda: multi-body"
(scm-syn-eval "((lambda (x) (define t (+ x 1)) (+ t t)) 5)" (scm-syn-env))
12)
(scm-syn-test
"lambda: rest-arg as bare symbol"
(scm-syn-eval "((lambda args args) 1 2 3)" (scm-syn-env))
(list 1 2 3))
;; ── closures ─────────────────────────────────────────────────────
(scm-syn-test
"closure: captures binding"
(let
((env (scm-syn-env)))
(scm-syn-eval-all
"(define (make-adder n) (lambda (x) (+ x n))) ((make-adder 10) 5)"
env))
15)
(scm-syn-test
"closure: counter via set!"
(let
((env (scm-syn-env)))
(scm-syn-eval-all
"(define (make-counter) (define n 0) (lambda () (set! n (+ n 1)) n)) (define c (make-counter)) (c) (c) (c)"
env))
3)
(scm-syn-test
"closure: curried"
(let
((env (scm-syn-env)))
(scm-syn-eval-all
"(define curry+ (lambda (a) (lambda (b) (lambda (c) (+ a (+ b c)))))) (((curry+ 1) 2) 3)"
env))
6)
;; ── recursion ────────────────────────────────────────────────────
(scm-syn-test
"recursive: factorial 5"
(let
((env (scm-syn-env)))
(scm-syn-eval-all
"(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 5)"
env))
120)
(scm-syn-test
"recursive: factorial 10"
(let
((env (scm-syn-env)))
(scm-syn-eval-all
"(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)"
env))
3628800)
(scm-syn-test
"recursive: list length"
(let
((env (scm-syn-env)))
(scm-syn-eval-all
"(define (len xs) (if (= 0 (- 0 0)) (if (= xs (quote ())) 0 (+ 1 (len (cdr xs)))) 0)) (len '(a b c d))"
env))
4)
;; ── quote vs eval distinction ────────────────────────────────────
(scm-syn-test
"quote: list literal"
(scm-syn-eval "'(1 2 3)" (scm-syn-env))
(list 1 2 3))
(scm-syn-test
"quote: nested"
(scm-syn-eval "'(a (b c) d)" (scm-syn-env))
(list "a" (list "b" "c") "d"))
(scm-syn-test
"quote: symbol vs evaluated"
(let ((env (scm-syn-env))) (scm-syn-eval-all "(define x 42) 'x" env))
"x")
(define scm-syn-tests-run! (fn () {:total (+ scm-syn-pass scm-syn-fail) :passed scm-syn-pass :failed scm-syn-fail :fails scm-syn-fails}))