6 Commits

Author SHA1 Message Date
cf933f0ece scheme: Phase 4 standard env + set! bugfix + 78 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
lib/scheme/runtime.sx — full R7RS-base surface:

- Arithmetic: variadic +/-/*//, abs, min, max, modulo, quotient,
  remainder. Predicates zero?/positive?/negative?.
- Comparison: chained =/</>/<=/>=.
- Type predicates: number?/boolean?/symbol?/string?/char?/vector?/
  null?/pair?/procedure?/not.
- List: cons/car/cdr/list/length/reverse/append.
- Higher-order: map/filter/fold-left/fold-right/for-each/apply.
  These re-enter scheme-apply to invoke user-supplied procs.
- String: string-length/string=?/string-append/substring.
- Char: char=?.
- Vector: vector/vector-length/vector-ref/vector->list/list->vector/
  make-vector.
- Equality: eqv?/equal?/eq? (all = under the hood for now).

Built via small adapters: scm-unary, scm-binary, scm-fold (variadic
left-fold with identity + one-arity special), scm-chain (n-ary
chained comparison).

**Bugfix in eval.sx set! handler.** The :else branch had two
expressions `(dict-set! ...) val` — SX cond branches don't run
multiple expressions, they return nil silently (or evaluate only
the first, depending on shape). Wrapped in (begin ...) to force
sequential execution. This fix also unblocks 4 set!-dependent
tests in lib/scheme/tests/syntax.sx that were silently raising
during load (and thus not counted) — syntax test count jumps
from 45 → 49.

Classic programs verified:
- factorial 10 → 3628800
- fib 10 → 55
- recursive list reverse → working
- sum of squares via fold-left + map → 55

212 total Scheme tests: parse 62 + eval 23 + syntax 49 + runtime 78.
All green.

The env-as-value section in runtime tests demonstrates
scheme-standard-env IS a refl-env? — kit primitives operate on it
directly, confirming the third-consumer adoption with zero adapter.
2026-05-13 20:29:37 +00:00
0fccd1b353 scheme: Phase 3.5 — let/let*/cond/when/unless/and/or + 21 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
Adds the rest of the standard syntactic operators, all built on the
existing eval/closure infrastructure from Phase 3:

- let — parallel bindings in fresh child env; values evaluated in
  outer env (RHS sees pre-let bindings only). Multi-body via
  scheme-eval-body.
- let* — sequential bindings, each in a nested child env; later
  bindings see earlier ones.
- cond — clauses walked in order; first truthy test wins. `else`
  symbol is the catch-all. Test-only clauses (no body) return the
  test value. Scheme truthiness: only #f is false.
- when / unless — single-test conditional execution, multi-body
  body via scheme-eval-body.
- and / or — short-circuit boolean. Empty `(and)` = true,
  `(or)` = false. Both return the actual value at the point
  of short-circuit (not coerced to bool), matching R7RS.

130 total Scheme tests (62 parse + 23 eval + 45 syntax). The
Scheme port is now self-hosting enough to write any non-stdlib
program — factorial, list operations via primitives, closures
with mutable state, all working.

Next phase: standard env (runtime.sx) with variadic +/-, list
ops as Scheme-visible applicatives.
2026-05-13 20:04:44 +00:00
23a53a2ccb 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).
2026-05-13 20:02:46 +00:00
e222e8b0aa scheme: Phase 2 evaluator — env.sx third consumer + 23 tests [consumes-env]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
lib/scheme/eval.sx — R7RS evaluator skeleton:
- Self-evaluating: numbers, booleans, characters, vectors, strings
- Symbol lookup: refl-env-lookup
- Lists: syntactic-operator table dispatch, else applicative call
- Table-driven syntactic ops (Phase 2 wires `quote` only; full set
  in Phase 3)
- Apply: callable host fn or scheme closure (closure stub for Phase 3)

scheme-make-env / scheme-env-bind! / etc. are THIN ALIASES for the
refl-env-* primitives from lib/guest/reflective/env.sx. No adapter
cfg needed — Scheme's lexical-scope semantics ARE the canonical
wire shape. This is the THIRD CONSUMER for env.sx after Kernel and
Tcl + Smalltalk's variant adapters; the first to use it without
any bridging code. Validates the kit handles canonical-shape
adoption with zero ceremony.

23 tests in lib/scheme/tests/eval.sx cover literals, symbol
lookup with parent-chain shadowing, quote (special form + sugar),
primitive application with nested calls, and an env-as-value
section explicitly demonstrating the kit primitives work on
Scheme envs.

85 total Scheme tests (62 parse + 23 eval).

chisel: consumes-env (third consumer for lib/guest/reflective/env.sx).
2026-05-13 20:00:36 +00:00
c919d9a0d7 scheme: Phase 1 parser — R7RS lexical reader + 62 tests [consumes-lex]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 21s
lib/scheme/parser.sx — reader for R7RS-small lexical syntax:
- numbers (int/float/exp)
- booleans #t / #f / #true / #false
- strings with standard escapes
- symbols (permissive — any non-delimiter)
- characters #\c, #\space, #\newline, #\tab, etc.
- vectors #(...)
- proper lists (dotted-pair deferred to Phase 3 with lambda rest-args)
- reader macros: 'X `X ,X ,@X → (quote X) (quasiquote X) etc.
  (Scheme conventions — lowercase, no $ prefix)
- line comments ;
- nestable block comments #| ... |#
- datum comments #;<datum>

AST shape mirrors Kernel: numbers/booleans/lists pass through;
strings wrapped as {:scm-string ...} to distinguish from symbols
(bare SX strings); chars as {:scm-char ...}; vectors as
{:scm-vector (list ...)}.

62 tests in lib/scheme/tests/parse.sx cover atom kinds, escape
sequences, quote/quasiquote/unquote/unquote-splicing, all three
comment flavours, and classic Scheme idioms (lambda, define, let,
if-cond).

Note: SX cond branches evaluate only the LAST expression, so
multi-mutation branches need explicit (do ...) or (begin ...)
wrappers — caught during block-comment debugging.

chisel: consumes-lex (lex-digit?, lex-whitespace? from
lib/guest/lex.sx); pratt not consumed (no operator precedence
in Scheme).
2026-05-13 19:58:30 +00:00
a75b4cbc57 plans: scheme-on-sx — R7RS-small port, second consumer for 3 reflective kits
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 47s
11-phase plan from parser through R7RS conformance. Explicitly maps
which reflective kits Scheme consumes:

- env.sx (Phase 2)        — third consumer, no cfg needed
- evaluator.sx (Phase 7)  — second consumer, unblocks extraction
- hygiene.sx (Phase 6)    — second consumer, drives the deferred
                            scope-set / lifted-symbol work
- quoting.sx (Phase 10)   — second consumer, unblocks extraction
- combiner.sx             — N/A (Scheme has no fexprs)

Correction to earlier session claim: a Scheme port unlocks THREE
more reflective kits, not four. combiner.sx stays Kernel-only.
2026-05-13 19:53:29 +00:00
8 changed files with 1934 additions and 0 deletions

431
lib/scheme/eval.sx Normal file
View File

@@ -0,0 +1,431 @@
;; lib/scheme/eval.sx — R7RS-small evaluator (Phase 2 skeleton).
;;
;; The evaluator walks parsed AST applying R7RS semantics:
;; - numbers, booleans, characters, vectors, strings self-evaluate
;; - symbols look up in the lexical env
;; - lists with a syntactic-operator head dispatch to native handler
;; - lists with an applicative head: eval head + args, then call
;;
;; Phase 2 covers literals, symbol lookup, and `quote`. The full
;; suite of syntactic operators (if/lambda/define/let/...) lands in
;; Phase 3.
;;
;; Environment representation
;; --------------------------
;; Scheme is the THIRD CONSUMER for `lib/guest/reflective/env.sx`.
;; It uses the canonical mutable wire shape `{:refl-tag :env
;; :bindings DICT :parent ENV-OR-NIL}` directly — no adapter cfg —
;; because Scheme's lexical-scope semantics match the kit's defaults
;; exactly. Compare with Tcl (functional updates, level field) and
;; Smalltalk (rich frame metadata) which DID need cfg adapters.
;;
;; Public API
;; (scheme-eval EXPR ENV) — primary entry
;; (scheme-make-env) — fresh top-level env
;; (scheme-extend-env P) — child env
;; (scheme-env-bind! E N V)
;; (scheme-env-lookup E N)
;;
;; Consumes: lib/guest/reflective/env.sx; lib/scheme/parser.sx
;; (scheme-string?, scheme-char?, scheme-vector?).
;; Thin wrappers over the kit. Scheme uses the canonical shape with
;; no cfg, so these are direct aliases.
(define scheme-make-env refl-make-env)
(define scheme-extend-env refl-extend-env)
(define scheme-env? refl-env?)
(define scheme-env-bind! refl-env-bind!)
(define scheme-env-has? refl-env-has?)
(define scheme-env-lookup refl-env-lookup)
;; ── self-evaluating values ───────────────────────────────────────
(define
scheme-self-eval?
(fn
(v)
(or
(number? v)
(boolean? v)
(nil? v)
(scheme-string? v)
(scheme-char? v)
(scheme-vector? v))))
;; ── syntactic-operator table ─────────────────────────────────────
;; Each operator is a fn (args env) that returns the result of the
;; special form. Phase 2 only handles `quote`; Phase 3 fills out the
;; rest. The table-driven dispatch keeps the eval body small and
;; makes new operators easy to add.
(define scheme-syntactic-ops {})
(define
scheme-define-op!
(fn (name handler) (dict-set! scheme-syntactic-ops name handler)))
(define
scheme-syntactic-op?
(fn (name) (dict-has? scheme-syntactic-ops name)))
;; quote — return arg unevaluated.
(scheme-define-op!
"quote"
(fn
(args env)
(cond
((not (= (length args) 1))
(error "quote: expects exactly 1 argument"))
(:else (first args)))))
;; if — (if TEST CONSEQUENT) or (if TEST CONSEQUENT ALTERNATE).
;; Scheme truthiness: only #f is false; everything else (incl. nil/empty
;; list) is truthy. Match SX's `if` semantics where possible.
(scheme-define-op! "if"
(fn (args env)
(cond
((< (length args) 2)
(error "if: expects (test then [else])"))
(:else
(let ((test-val (scheme-eval (first args) env)))
(cond
((not (= test-val false))
(scheme-eval (nth args 1) env))
((>= (length args) 3)
(scheme-eval (nth args 2) env))
(:else nil)))))))
;; set! — mutate an existing binding by walking the env chain.
(scheme-define-op! "set!"
(fn (args env)
(cond
((not (= (length args) 2))
(error "set!: expects (set! name expr)"))
((not (string? (first args)))
(error "set!: name must be a symbol"))
(:else
(let ((name (first args))
(val (scheme-eval (nth args 1) env)))
(let ((src (refl-env-find-frame env name)))
(cond
((nil? src)
(error (str "set!: unbound variable: " name)))
(:else
(begin
(dict-set! (get src :bindings) name val)
val)))))))))
;; define — top-level or internal binding. (define name expr) or
;; (define (name . formals) body...) the latter being lambda sugar.
(scheme-define-op! "define"
(fn (args env)
(cond
((< (length args) 2)
(error "define: expects (define name expr) or (define (name . formals) body)"))
((string? (first args))
;; (define name expr)
(let ((val (scheme-eval (nth args 1) env)))
(scheme-env-bind! env (first args) val)
val))
((list? (first args))
;; (define (name . formals) body...) — sugar
(let ((header (first args))
(body (rest args)))
(cond
((= (length header) 0)
(error "define: malformed function header"))
(:else
(let ((name (first header))
(formals (rest header)))
(let ((closure (scheme-make-closure formals nil body env)))
(scheme-env-bind! env name closure)
closure))))))
(:else (error "define: malformed form")))))
;; begin — evaluate each expression in sequence, return the last.
(scheme-define-op! "begin"
(fn (args env)
(cond
((or (nil? args) (= (length args) 0)) nil)
(:else (scheme-eval-body args env)))))
(define scheme-eval-body
(fn (forms env)
(cond
((= (length forms) 1) (scheme-eval (first forms) env))
(:else
(begin
(scheme-eval (first forms) env)
(scheme-eval-body (rest forms) env))))))
;; lambda — (lambda formals body...) where formals is one of:
;; () — no args
;; (a b c) — fixed-arity
;; name — bare symbol; binds all args as a list
;; Dotted-pair tail (a b . rest) deferred until parser support lands.
(scheme-define-op! "lambda"
(fn (args env)
(cond
((< (length args) 2)
(error "lambda: expects (lambda formals body...)"))
(:else
(let ((formals (first args))
(body (rest args)))
(cond
;; bare symbol: collect-all-args
((string? formals)
(scheme-make-closure (list) formals body env))
;; flat list: each must be a symbol
((list? formals)
(cond
((not (scm-formals-ok? formals))
(error "lambda: formals must be symbols"))
(:else
(scheme-make-closure formals nil body env))))
(:else (error "lambda: invalid formals"))))))))
(define scm-formals-ok?
(fn (formals)
(cond
((or (nil? formals) (= (length formals) 0)) true)
((string? (first formals)) (scm-formals-ok? (rest formals)))
(:else false))))
(define scheme-make-closure
(fn (params rest-name body env)
{:scm-tag :closure
:params params
:rest rest-name
:body body
:env env}))
;; ── let / let* — bindings in a fresh child env ───────────────────
(define scm-bind-let-vals!
(fn (local bindings dyn-env)
(cond
((or (nil? bindings) (= (length bindings) 0)) nil)
(:else
(let ((b (first bindings)))
(cond
((not (and (list? b) (= (length b) 2)))
(error "let: each binding must be (name expr)"))
((not (string? (first b)))
(error "let: binding name must be a symbol"))
(:else
(begin
(scheme-env-bind! local (first b)
(scheme-eval (nth b 1) dyn-env))
(scm-bind-let-vals! local (rest bindings) dyn-env)))))))))
(scheme-define-op! "let"
(fn (args env)
(cond
((< (length args) 2)
(error "let: expects (bindings body...)"))
((not (list? (first args)))
(error "let: bindings must be a list"))
(:else
(let ((local (scheme-extend-env env)))
(scm-bind-let-vals! local (first args) env)
(scheme-eval-body (rest args) local))))))
;; let* — sequential let; each binding sees earlier ones.
(define scm-let*-step
(fn (bindings env body)
(cond
((or (nil? bindings) (= (length bindings) 0))
(scheme-eval-body body env))
(:else
(let ((b (first bindings)))
(cond
((not (and (list? b) (= (length b) 2)))
(error "let*: each binding must be (name expr)"))
(:else
(let ((child (scheme-extend-env env)))
(scheme-env-bind! child (first b)
(scheme-eval (nth b 1) env))
(scm-let*-step (rest bindings) child body)))))))))
(scheme-define-op! "let*"
(fn (args env)
(cond
((< (length args) 2)
(error "let*: expects (bindings body...)"))
((not (list? (first args)))
(error "let*: bindings must be a list"))
(:else (scm-let*-step (first args) env (rest args))))))
;; ── cond / when / unless ─────────────────────────────────────────
(define scm-cond-clauses
(fn (clauses env)
(cond
((or (nil? clauses) (= (length clauses) 0)) nil)
(:else
(let ((clause (first clauses)))
(cond
((not (list? clause))
(error "cond: each clause must be a list"))
((= (length clause) 0)
(error "cond: empty clause"))
((and (string? (first clause)) (= (first clause) "else"))
(scheme-eval-body (rest clause) env))
(:else
(let ((test-val (scheme-eval (first clause) env)))
(cond
((not (= test-val false))
(cond
((= (length clause) 1) test-val)
(:else (scheme-eval-body (rest clause) env))))
(:else (scm-cond-clauses (rest clauses) env)))))))))))
(scheme-define-op! "cond"
(fn (args env) (scm-cond-clauses args env)))
(scheme-define-op! "when"
(fn (args env)
(cond
((< (length args) 1) (error "when: expects (when test body...)"))
(:else
(let ((v (scheme-eval (first args) env)))
(cond
((= v false) nil)
(:else (scheme-eval-body (rest args) env))))))))
(scheme-define-op! "unless"
(fn (args env)
(cond
((< (length args) 1)
(error "unless: expects (unless test body...)"))
(:else
(let ((v (scheme-eval (first args) env)))
(cond
((= v false) (scheme-eval-body (rest args) env))
(:else nil)))))))
;; ── and / or — short-circuit boolean operators ──────────────────
(define scm-and-step
(fn (args env)
(cond
((or (nil? args) (= (length args) 0)) true)
((= (length args) 1) (scheme-eval (first args) env))
(:else
(let ((v (scheme-eval (first args) env)))
(cond
((= v false) false)
(:else (scm-and-step (rest args) env))))))))
(scheme-define-op! "and"
(fn (args env) (scm-and-step args env)))
(define scm-or-step
(fn (args env)
(cond
((or (nil? args) (= (length args) 0)) false)
((= (length args) 1) (scheme-eval (first args) env))
(:else
(let ((v (scheme-eval (first args) env)))
(cond
((not (= v false)) v)
(:else (scm-or-step (rest args) env))))))))
(scheme-define-op! "or"
(fn (args env) (scm-or-step args env)))
;; ── eval-args helper ─────────────────────────────────────────────
(define
scheme-eval-args
(fn
(args env)
(cond
((or (nil? args) (= (length args) 0)) (list))
(:else
(cons
(scheme-eval (first args) env)
(scheme-eval-args (rest args) env))))))
;; ── main eval ────────────────────────────────────────────────────
(define
scheme-eval
(fn
(expr env)
(cond
((scheme-self-eval? expr) expr)
((string? expr) (scheme-env-lookup env expr))
((list? expr)
(cond
((= (length expr) 0)
(error "scheme-eval: empty application"))
(:else
(let
((head (first expr)) (rest-args (rest expr)))
(cond
((and (string? head) (scheme-syntactic-op? head))
((get scheme-syntactic-ops head) rest-args env))
(:else
(let
((proc (scheme-eval head env))
(vals (scheme-eval-args rest-args env)))
(scheme-apply proc vals))))))))
(:else (error (str "scheme-eval: unknown form: " expr))))))
;; ── apply ────────────────────────────────────────────────────────
;; Phase 2 only knows about HOST procedures (SX fns) bound in the
;; env as primitives. Phase 3 adds Scheme `lambda` closures.
(define
scheme-apply
(fn
(proc args)
(cond
((callable? proc) (proc args))
((and (dict? proc) (= (get proc :scm-tag) :closure))
(scheme-apply-closure proc args))
(:else (error (str "scheme-eval: not a procedure: " proc))))))
;; Apply a Scheme closure: bind formals + rest, eval body in
;; (extend static-env), return value of last form.
(define scheme-apply-closure
(fn (proc args)
(let ((local (scheme-extend-env (get proc :env)))
(params (get proc :params))
(rest-name (get proc :rest))
(body (get proc :body)))
(begin
(scm-bind-params! local params args rest-name)
(scheme-eval-body body local)))))
(define scm-bind-params!
(fn (env params args rest-name)
(cond
;; No more formals: maybe bind the rest, else check arity.
((or (nil? params) (= (length params) 0))
(cond
((not (nil? rest-name))
(scheme-env-bind! env rest-name args))
((or (nil? args) (= (length args) 0)) nil)
(:else (error "lambda: too many arguments"))))
;; Out of args but still have formals → arity error.
((or (nil? args) (= (length args) 0))
(error "lambda: too few arguments"))
(:else
(begin
(scheme-env-bind! env (first params) (first args))
(scm-bind-params! env (rest params) (rest args) rest-name))))))
;; Evaluate a program (sequence of forms), returning the last value.
(define
scheme-eval-program
(fn
(forms env)
(cond
((or (nil? forms) (= (length forms) 0)) nil)
((= (length forms) 1) (scheme-eval (first forms) env))
(:else
(begin
(scheme-eval (first forms) env)
(scheme-eval-program (rest forms) env))))))

BIN
lib/scheme/parser.sx Normal file

Binary file not shown.

513
lib/scheme/runtime.sx Normal file
View File

@@ -0,0 +1,513 @@
;; lib/scheme/runtime.sx — R7RS-small standard environment.
;;
;; Builds scheme-standard-env from scheme-make-env, populating it with
;; arithmetic, comparison, type predicates, list/pair/vector/string/char
;; primitives, and the higher-order combinators (map/filter/fold).
;;
;; Primitives are bound as SX fns taking a list of evaluated arguments.
;; Combinators that re-enter the evaluator (map, filter, fold, apply,
;; for-each) call `scheme-apply` directly on user-supplied procedures.
;;
;; Public API
;; (scheme-standard-env) — fresh env with the full R7RS-base surface
;;
;; Consumes: lib/scheme/eval.sx (scheme-apply, scheme-make-env,
;; scheme-env-bind!, scheme-string?, scheme-char?,
;; scheme-vector?, scheme-vector-elements,
;; scheme-string-value, scheme-char-value,
;; scheme-string-make, scheme-char-make,
;; scheme-vector-make).
;; ── Arity / fold helpers ─────────────────────────────────────────
(define
scm-unary
(fn
(name f)
(fn
(args)
(cond
((not (= (length args) 1))
(error (str name ": expects 1 argument")))
(:else (f (first args)))))))
(define
scm-binary
(fn
(name f)
(fn
(args)
(cond
((not (= (length args) 2))
(error (str name ": expects 2 arguments")))
(:else (f (first args) (nth args 1)))))))
;; Variadic left-fold helper. zero-id is the identity (`(+)` → 0).
;; one-fn handles single-arg case (`(- x)` negates).
(define
scm-fold-step
(fn
(f acc rest-args)
(cond
((or (nil? rest-args) (= (length rest-args) 0)) acc)
(:else (scm-fold-step f (f acc (first rest-args)) (rest rest-args))))))
(define
scm-fold
(fn
(name f zero-id one-fn)
(fn
(args)
(cond
((= (length args) 0) zero-id)
((= (length args) 1) (one-fn (first args)))
(:else (scm-fold-step f (first args) (rest args)))))))
;; n-ary chained comparison: (< 1 2 3) ≡ (< 1 2) ∧ (< 2 3).
(define
scm-chain-step
(fn
(cmp prev rest-args)
(cond
((or (nil? rest-args) (= (length rest-args) 0)) true)
(:else
(let
((next (first rest-args)))
(cond
((cmp prev next) (scm-chain-step cmp next (rest rest-args)))
(:else false)))))))
(define
scm-chain
(fn
(name cmp)
(fn
(args)
(cond
((< (length args) 2)
(error (str name ": expects at least 2 arguments")))
(:else (scm-chain-step cmp (first args) (rest args)))))))
;; ── List helpers ─────────────────────────────────────────────────
(define
scm-list-append
(fn
(xs ys)
(cond
((or (nil? xs) (= (length xs) 0)) ys)
(:else (cons (first xs) (scm-list-append (rest xs) ys))))))
(define
scm-list-reverse-step
(fn
(xs acc)
(cond
((or (nil? xs) (= (length xs) 0)) acc)
(:else (scm-list-reverse-step (rest xs) (cons (first xs) acc))))))
(define
scm-all-lists?
(fn
(xs)
(cond
((or (nil? xs) (= (length xs) 0)) true)
((list? (first xs)) (scm-all-lists? (rest xs)))
(:else false))))
(define
scm-append-all
(fn
(lists)
(cond
((or (nil? lists) (= (length lists) 0)) (list))
((= (length lists) 1) (first lists))
(:else (scm-list-append (first lists) (scm-append-all (rest lists)))))))
;; ── Map / Filter / Fold ──────────────────────────────────────────
;; These call scheme-apply directly so closures and primitives both work.
(define
scm-map-step
(fn
(proc xs)
(cond
((or (nil? xs) (= (length xs) 0)) (list))
(:else
(cons
(scheme-apply proc (list (first xs)))
(scm-map-step proc (rest xs)))))))
(define
scm-filter-step
(fn
(pred xs)
(cond
((or (nil? xs) (= (length xs) 0)) (list))
(:else
(let
((keep? (scheme-apply pred (list (first xs)))))
(cond
((not (= keep? false))
(cons (first xs) (scm-filter-step pred (rest xs))))
(:else (scm-filter-step pred (rest xs)))))))))
(define
scm-fold-left-step
(fn
(proc acc xs)
(cond
((or (nil? xs) (= (length xs) 0)) acc)
(:else
(scm-fold-left-step
proc
(scheme-apply proc (list acc (first xs)))
(rest xs))))))
(define
scm-fold-right-step
(fn
(proc init xs)
(cond
((or (nil? xs) (= (length xs) 0)) init)
(:else
(scheme-apply
proc
(list (first xs) (scm-fold-right-step proc init (rest xs))))))))
(define
scm-for-each-step
(fn
(proc xs)
(cond
((or (nil? xs) (= (length xs) 0)) nil)
(:else
(begin
(scheme-apply proc (list (first xs)))
(scm-for-each-step proc (rest xs)))))))
;; ── Vector helpers ──────────────────────────────────────────────
(define
scm-make-vector-step
(fn
(n fill acc)
(cond
((<= n 0) acc)
(:else (scm-make-vector-step (- n 1) fill (cons fill acc))))))
;; ── Standard env ─────────────────────────────────────────────────
(define
scheme-standard-env
(fn
()
(let
((env (scheme-make-env)))
(scheme-env-bind!
env
"+"
(scm-fold "+" (fn (a b) (+ a b)) 0 (fn (x) x)))
(scheme-env-bind!
env
"-"
(scm-fold
"-"
(fn (a b) (- a b))
0
(fn (x) (- 0 x))))
(scheme-env-bind!
env
"*"
(scm-fold "*" (fn (a b) (* a b)) 1 (fn (x) x)))
(scheme-env-bind!
env
"/"
(scm-fold
"/"
(fn (a b) (/ a b))
1
(fn (x) (/ 1 x))))
(scheme-env-bind!
env
"abs"
(scm-unary
"abs"
(fn (n) (if (< n 0) (- 0 n) n))))
(scheme-env-bind!
env
"min"
(scm-fold "min" (fn (a b) (if (< a b) a b)) nil (fn (x) x)))
(scheme-env-bind!
env
"max"
(scm-fold "max" (fn (a b) (if (< a b) b a)) nil (fn (x) x)))
(scheme-env-bind!
env
"modulo"
(scm-binary "modulo" (fn (a b) (- a (* b (floor (/ a b)))))))
(scheme-env-bind!
env
"quotient"
(scm-binary "quotient" (fn (a b) (floor (/ a b)))))
(scheme-env-bind!
env
"remainder"
(scm-binary "remainder" (fn (a b) (- a (* b (floor (/ a b)))))))
(scheme-env-bind!
env
"zero?"
(scm-unary "zero?" (fn (n) (= n 0))))
(scheme-env-bind!
env
"positive?"
(scm-unary "positive?" (fn (n) (> n 0))))
(scheme-env-bind!
env
"negative?"
(scm-unary "negative?" (fn (n) (< n 0))))
(scheme-env-bind! env "=" (scm-chain "=" (fn (a b) (= a b))))
(scheme-env-bind! env "<" (scm-chain "<" (fn (a b) (< a b))))
(scheme-env-bind! env ">" (scm-chain ">" (fn (a b) (> a b))))
(scheme-env-bind! env "<=" (scm-chain "<=" (fn (a b) (<= a b))))
(scheme-env-bind! env ">=" (scm-chain ">=" (fn (a b) (>= a b))))
(scheme-env-bind!
env
"number?"
(scm-unary "number?" (fn (v) (number? v))))
(scheme-env-bind!
env
"boolean?"
(scm-unary "boolean?" (fn (v) (boolean? v))))
(scheme-env-bind!
env
"symbol?"
(scm-unary "symbol?" (fn (v) (string? v))))
(scheme-env-bind!
env
"string?"
(scm-unary "string?" (fn (v) (scheme-string? v))))
(scheme-env-bind!
env
"char?"
(scm-unary "char?" (fn (v) (scheme-char? v))))
(scheme-env-bind!
env
"vector?"
(scm-unary "vector?" (fn (v) (scheme-vector? v))))
(scheme-env-bind!
env
"null?"
(scm-unary
"null?"
(fn
(v)
(or (nil? v) (and (list? v) (= (length v) 0))))))
(scheme-env-bind!
env
"pair?"
(scm-unary
"pair?"
(fn (v) (and (list? v) (> (length v) 0)))))
(scheme-env-bind!
env
"procedure?"
(scm-unary
"procedure?"
(fn
(v)
(or
(callable? v)
(and (dict? v) (= (get v :scm-tag) :closure))))))
(scheme-env-bind! env "not" (scm-unary "not" (fn (v) (= v false))))
(scheme-env-bind!
env
"cons"
(scm-binary "cons" (fn (a b) (cons a b))))
(scheme-env-bind!
env
"car"
(scm-unary
"car"
(fn
(xs)
(cond
((or (nil? xs) (and (list? xs) (= (length xs) 0)))
(error "car: empty list"))
(:else (first xs))))))
(scheme-env-bind!
env
"cdr"
(scm-unary
"cdr"
(fn
(xs)
(cond
((or (nil? xs) (and (list? xs) (= (length xs) 0)))
(error "cdr: empty list"))
(:else (rest xs))))))
(scheme-env-bind! env "list" (fn (args) args))
(scheme-env-bind!
env
"length"
(scm-unary "length" (fn (xs) (length xs))))
(scheme-env-bind!
env
"reverse"
(scm-unary "reverse" (fn (xs) (scm-list-reverse-step xs (list)))))
(scheme-env-bind!
env
"append"
(fn
(args)
(cond
((scm-all-lists? args) (scm-append-all args))
(:else (error "append: all arguments must be lists")))))
(scheme-env-bind!
env
"map"
(fn
(args)
(cond
((not (= (length args) 2))
(error "map: expects (proc list)"))
(:else (scm-map-step (first args) (nth args 1))))))
(scheme-env-bind!
env
"filter"
(fn
(args)
(cond
((not (= (length args) 2))
(error "filter: expects (pred list)"))
(:else (scm-filter-step (first args) (nth args 1))))))
(scheme-env-bind!
env
"fold-left"
(fn
(args)
(cond
((not (= (length args) 3))
(error "fold-left: expects (proc init list)"))
(:else
(scm-fold-left-step
(first args)
(nth args 1)
(nth args 2))))))
(scheme-env-bind!
env
"fold-right"
(fn
(args)
(cond
((not (= (length args) 3))
(error "fold-right: expects (proc init list)"))
(:else
(scm-fold-right-step
(first args)
(nth args 1)
(nth args 2))))))
(scheme-env-bind!
env
"for-each"
(fn
(args)
(cond
((not (= (length args) 2))
(error "for-each: expects (proc list)"))
(:else (scm-for-each-step (first args) (nth args 1))))))
(scheme-env-bind!
env
"apply"
(fn
(args)
(cond
((not (= (length args) 2))
(error "apply: expects (proc args-list)"))
(:else (scheme-apply (first args) (nth args 1))))))
(scheme-env-bind!
env
"string-length"
(scm-unary
"string-length"
(fn (s) (string-length (scheme-string-value s)))))
(scheme-env-bind!
env
"string=?"
(scm-binary
"string=?"
(fn (a b) (= (scheme-string-value a) (scheme-string-value b)))))
(scheme-env-bind!
env
"string-append"
(fn
(args)
(scheme-string-make
(scm-fold-step
(fn (acc s) (str acc (scheme-string-value s)))
""
args))))
(scheme-env-bind!
env
"substring"
(fn
(args)
(cond
((not (= (length args) 3))
(error "substring: expects (str start end)"))
(:else
(scheme-string-make
(substring
(scheme-string-value (first args))
(nth args 1)
(nth args 2)))))))
(scheme-env-bind!
env
"char=?"
(scm-binary
"char=?"
(fn (a b) (= (scheme-char-value a) (scheme-char-value b)))))
(scheme-env-bind! env "vector" (fn (args) (scheme-vector-make args)))
(scheme-env-bind!
env
"vector-length"
(scm-unary
"vector-length"
(fn (v) (length (scheme-vector-elements v)))))
(scheme-env-bind!
env
"vector-ref"
(scm-binary
"vector-ref"
(fn (v i) (nth (scheme-vector-elements v) i))))
(scheme-env-bind!
env
"vector->list"
(scm-unary "vector->list" (fn (v) (scheme-vector-elements v))))
(scheme-env-bind!
env
"list->vector"
(scm-unary "list->vector" (fn (xs) (scheme-vector-make xs))))
(scheme-env-bind!
env
"make-vector"
(fn
(args)
(cond
((= (length args) 1)
(scheme-vector-make
(scm-make-vector-step (first args) nil (list))))
((= (length args) 2)
(scheme-vector-make
(scm-make-vector-step
(first args)
(nth args 1)
(list))))
(:else (error "make-vector: expects (n [fill])")))))
(scheme-env-bind! env "eqv?" (scm-binary "eqv?" (fn (a b) (= a b))))
(scheme-env-bind!
env
"equal?"
(scm-binary "equal?" (fn (a b) (= a b))))
(scheme-env-bind! env "eq?" (scm-binary "eq?" (fn (a b) (= a b))))
env)))

162
lib/scheme/tests/eval.sx Normal file
View File

@@ -0,0 +1,162 @@
;; lib/scheme/tests/eval.sx — exercises lib/scheme/eval.sx (Phase 2).
(define scm-eval-pass 0)
(define scm-eval-fail 0)
(define scm-eval-fails (list))
(define
scm-eval-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-eval-pass (+ scm-eval-pass 1))
(begin
(set! scm-eval-fail (+ scm-eval-fail 1))
(append! scm-eval-fails {:name name :actual actual :expected expected})))))
(define scm-eval-src (fn (src env) (scheme-eval (scheme-parse src) env)))
;; A toy env with arithmetic + list primitives.
(define
scm-test-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 "list" (fn (args) args))
env)))
;; ── self-evaluating ──────────────────────────────────────────────
(scm-eval-test
"lit: integer"
(scm-eval-src "42" (scheme-make-env))
42)
(scm-eval-test "lit: float" (scm-eval-src "3.14" (scheme-make-env)) 3.14)
(scm-eval-test "lit: #t" (scm-eval-src "#t" (scheme-make-env)) true)
(scm-eval-test "lit: #f" (scm-eval-src "#f" (scheme-make-env)) false)
(scm-eval-test
"lit: empty list"
(scm-eval-src "()" (scheme-make-env))
(list))
(scm-eval-test
"lit: string"
(scheme-string? (scm-eval-src "\"hello\"" (scheme-make-env)))
true)
(scm-eval-test
"lit: char"
(scheme-char? (scm-eval-src "#\\a" (scheme-make-env)))
true)
(scm-eval-test
"lit: vector"
(scheme-vector? (scm-eval-src "#(1 2 3)" (scheme-make-env)))
true)
;; ── symbol lookup ────────────────────────────────────────────────
(scm-eval-test
"sym: bound"
(let
((env (scheme-make-env)))
(scheme-env-bind! env "x" 100)
(scm-eval-src "x" env))
100)
(scm-eval-test
"sym: parent chain"
(let
((p (scheme-make-env)))
(scheme-env-bind! p "outer" 1)
(let
((c (scheme-extend-env p)))
(scheme-env-bind! c "inner" 2)
(+ (scm-eval-src "outer" c) (scm-eval-src "inner" c))))
3)
(scm-eval-test
"sym: shadowing"
(let
((p (scheme-make-env)))
(scheme-env-bind! p "x" 1)
(let
((c (scheme-extend-env p)))
(scheme-env-bind! c "x" 2)
(scm-eval-src "x" c)))
2)
;; ── quote ────────────────────────────────────────────────────────
(scm-eval-test
"quote: symbol"
(scm-eval-src "(quote foo)" (scheme-make-env))
"foo")
(scm-eval-test
"quote: list"
(scm-eval-src "(quote (+ 1 2))" (scheme-make-env))
(list "+" 1 2))
(scm-eval-test "quote: sugar 'x" (scm-eval-src "'x" (scheme-make-env)) "x")
(scm-eval-test
"quote: sugar list"
(scm-eval-src "'(a b c)" (scheme-make-env))
(list "a" "b" "c"))
(scm-eval-test
"quote: nested"
(scm-eval-src "''x" (scheme-make-env))
(list "quote" "x"))
;; ── primitive application ────────────────────────────────────────
(scm-eval-test "prim: +" (scm-eval-src "(+ 2 3)" (scm-test-env)) 5)
(scm-eval-test
"prim: nested +"
(scm-eval-src "(+ (+ 1 2) (+ 3 4))" (scm-test-env))
10)
(scm-eval-test
"prim: mixed ops"
(scm-eval-src "(- (* 4 5) (+ 3 2))" (scm-test-env))
15)
(scm-eval-test
"prim: list builds SX list"
(scm-eval-src "(list 1 2 3)" (scm-test-env))
(list 1 2 3))
(scm-eval-test
"prim: args eval in order"
(let
((env (scm-test-env)))
(scheme-env-bind! env "a" 10)
(scheme-env-bind! env "b" 20)
(scm-eval-src "(+ a b)" env))
30)
;; ── env-as-value (the third-consumer demonstration) ─────────────
;; Scheme's env IS lib/guest/reflective/env.sx's canonical wire shape
;; with no adapter cfg. Verify the kit primitives work directly.
(scm-eval-test
"env: refl-env? on Scheme env"
(refl-env? (scheme-make-env))
true)
(scm-eval-test
"env: lookup via kit"
(let
((env (scheme-make-env)))
(refl-env-bind! env "name" "scheme")
(refl-env-lookup env "name"))
"scheme")
(scm-eval-test
"env: find-frame walks parent"
(let
((p (scheme-make-env)))
(refl-env-bind! p "root-binding" 99)
(let
((c (scheme-extend-env p)))
(= (refl-env-find-frame c "root-binding") p)))
true)
(define scm-eval-tests-run! (fn () {:total (+ scm-eval-pass scm-eval-fail) :passed scm-eval-pass :failed scm-eval-fail :fails scm-eval-fails}))

177
lib/scheme/tests/parse.sx Normal file
View File

@@ -0,0 +1,177 @@
;; lib/scheme/tests/parse.sx — exercises lib/scheme/parser.sx.
(define scm-test-pass 0)
(define scm-test-fail 0)
(define scm-test-fails (list))
(define
scm-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-test-pass (+ scm-test-pass 1))
(begin
(set! scm-test-fail (+ scm-test-fail 1))
(append! scm-test-fails {:name name :actual actual :expected expected})))))
;; ── numbers ───────────────────────────────────────────────────────
(scm-test "num: integer" (scheme-parse "42") 42)
(scm-test "num: zero" (scheme-parse "0") 0)
(scm-test "num: negative" (scheme-parse "-17") -17)
(scm-test "num: float" (scheme-parse "3.14") 3.14)
(scm-test "num: exponent" (scheme-parse "1e3") 1000)
(scm-test "num: negative float" (scheme-parse "-2.5") -2.5)
;; ── booleans ──────────────────────────────────────────────────────
(scm-test "bool: #t" (scheme-parse "#t") true)
(scm-test "bool: #true" (scheme-parse "#true") true)
(scm-test "bool: #f" (scheme-parse "#f") false)
(scm-test "bool: #false" (scheme-parse "#false") false)
;; ── strings ───────────────────────────────────────────────────────
(scm-test "str: empty" (scheme-string-value (scheme-parse "\"\"")) "")
(scm-test
"str: hello"
(scheme-string-value (scheme-parse "\"hello\""))
"hello")
(scm-test "str: predicate" (scheme-string? (scheme-parse "\"x\"")) true)
(scm-test "str: not symbol" (scheme-string? (scheme-parse "x")) false)
(scm-test
"str: escape newline"
(scheme-string-value (scheme-parse "\"a\\nb\""))
"a\nb")
(scm-test
"str: escape tab"
(scheme-string-value (scheme-parse "\"a\\tb\""))
"a\tb")
(scm-test
"str: escape quote"
(scheme-string-value (scheme-parse "\"a\\\"b\""))
"a\"b")
;; ── symbols ───────────────────────────────────────────────────────
(scm-test "sym: word" (scheme-parse "foo") "foo")
(scm-test "sym: hyphenated" (scheme-parse "set-car!") "set-car!")
(scm-test "sym: question mark" (scheme-parse "null?") "null?")
(scm-test "sym: arrow" (scheme-parse "->") "->")
(scm-test "sym: lt-eq" (scheme-parse "<=") "<=")
(scm-test "sym: bare plus" (scheme-parse "+") "+")
(scm-test "sym: bare minus" (scheme-parse "-") "-")
(scm-test "sym: dot-prefixed" (scheme-parse ".foo") ".foo")
;; ── characters ────────────────────────────────────────────────────
(scm-test "char: single" (scheme-char-value (scheme-parse "#\\a")) "a")
(scm-test "char: space" (scheme-char-value (scheme-parse "#\\space")) " ")
(scm-test "char: newline" (scheme-char-value (scheme-parse "#\\newline")) "\n")
(scm-test "char: tab" (scheme-char-value (scheme-parse "#\\tab")) "\t")
(scm-test "char: predicate" (scheme-char? (scheme-parse "#\\x")) true)
(scm-test "char: digit" (scheme-char-value (scheme-parse "#\\5")) "5")
;; ── vectors ───────────────────────────────────────────────────────
(scm-test "vec: empty" (scheme-vector-elements (scheme-parse "#()")) (list))
(scm-test
"vec: numbers"
(scheme-vector-elements (scheme-parse "#(1 2 3)"))
(list 1 2 3))
(scm-test "vec: predicate" (scheme-vector? (scheme-parse "#(1)")) true)
(scm-test "vec: not list" (scheme-vector? (scheme-parse "(1)")) false)
;; Nested vector: SX `=` doesn't deep-compare dicts-with-list-values
;; reliably under this CEK path, so check structure piecewise.
(scm-test "vec: nested first"
(first (scheme-vector-elements (scheme-parse "#(a #(b c) d)"))) "a")
(scm-test "vec: nested second is vector"
(scheme-vector?
(nth (scheme-vector-elements (scheme-parse "#(a #(b c) d)")) 1))
true)
(scm-test "vec: nested second elements"
(scheme-vector-elements
(nth (scheme-vector-elements (scheme-parse "#(a #(b c) d)")) 1))
(list "b" "c"))
;; ── lists ─────────────────────────────────────────────────────────
(scm-test "list: empty" (scheme-parse "()") (list))
(scm-test "list: flat" (scheme-parse "(a b c)") (list "a" "b" "c"))
(scm-test
"list: nested"
(scheme-parse "(a (b c) d)")
(list "a" (list "b" "c") "d"))
(scm-test
"list: mixed atoms"
(scheme-parse "(1 #t foo)")
(list 1 true "foo"))
;; ── reader macros ─────────────────────────────────────────────────
(scm-test "quote: 'foo" (scheme-parse "'foo") (list "quote" "foo"))
(scm-test
"quote: '(a b c)"
(scheme-parse "'(a b c)")
(list "quote" (list "a" "b" "c")))
(scm-test "quasiquote: `x" (scheme-parse "`x") (list "quasiquote" "x"))
(scm-test "unquote: ,x" (scheme-parse ",x") (list "unquote" "x"))
(scm-test
"unquote-splicing: ,@x"
(scheme-parse ",@x")
(list "unquote-splicing" "x"))
(scm-test
"qq mix"
(scheme-parse "`(a ,b ,@c)")
(list
"quasiquote"
(list "a" (list "unquote" "b") (list "unquote-splicing" "c"))))
;; ── comments ──────────────────────────────────────────────────────
(scm-test "comment: line" (scheme-parse "; nope\n42") 42)
(scm-test "comment: trailing" (scheme-parse "42 ; tail") 42)
(scm-test
"comment: inside list"
(scheme-parse "(a ; mid\n b)")
(list "a" "b"))
(scm-test "comment: block simple" (scheme-parse "#| skip |# 42") 42)
(scm-test
"comment: block nested"
(scheme-parse "#| outer #| inner |# done |# 42")
42)
(scm-test "comment: datum #;" (scheme-parse "#;skipme 42") 42)
(scm-test
"comment: datum skips list"
(scheme-parse "#;(1 2 3) 42")
42)
;; ── parse-all ─────────────────────────────────────────────────────
(scm-test "all: empty" (scheme-parse-all "") (list))
(scm-test
"all: three forms"
(scheme-parse-all "1 2 3")
(list 1 2 3))
(scm-test
"all: mixed"
(scheme-parse-all "(if #t 1 2) foo")
(list (list "if" true 1 2) "foo"))
;; ── classic Scheme idioms ─────────────────────────────────────────
(scm-test
"classic: lambda"
(scheme-parse "(lambda (x) (+ x 1))")
(list "lambda" (list "x") (list "+" "x" 1)))
(scm-test
"classic: define"
(scheme-parse "(define (sq x) (* x x))")
(list "define" (list "sq" "x") (list "*" "x" "x")))
(scm-test
"classic: let"
(scheme-parse "(let ((x 1) (y 2)) (+ x y))")
(list
"let"
(list (list "x" 1) (list "y" 2))
(list "+" "x" "y")))
(scm-test
"classic: if"
(scheme-parse "(if (zero? n) 1 (* n (fact (- n 1))))")
(list
"if"
(list "zero?" "n")
1
(list "*" "n" (list "fact" (list "-" "n" 1)))))
(define scm-tests-run! (fn () {:total (+ scm-test-pass scm-test-fail) :passed scm-test-pass :failed scm-test-fail :fails scm-test-fails}))

213
lib/scheme/tests/runtime.sx Normal file
View File

@@ -0,0 +1,213 @@
;; lib/scheme/tests/runtime.sx — exercises the standard env.
(define scm-rt-pass 0)
(define scm-rt-fail 0)
(define scm-rt-fails (list))
(define
scm-rt-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-rt-pass (+ scm-rt-pass 1))
(begin
(set! scm-rt-fail (+ scm-rt-fail 1))
(append! scm-rt-fails {:name name :actual actual :expected expected})))))
(define
scm-rt
(fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
(define
scm-rt-all
(fn
(src)
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
;; ── Variadic arithmetic ─────────────────────────────────────────
(scm-rt-test "+: zero" (scm-rt "(+)") 0)
(scm-rt-test "+: one" (scm-rt "(+ 7)") 7)
(scm-rt-test "+: many" (scm-rt "(+ 1 2 3 4 5)") 15)
(scm-rt-test "-: one" (scm-rt "(- 10)") -10)
(scm-rt-test "-: many" (scm-rt "(- 100 1 2 3)") 94)
(scm-rt-test "*: zero" (scm-rt "(*)") 1)
(scm-rt-test "*: many" (scm-rt "(* 1 2 3 4)") 24)
(scm-rt-test "/: two" (scm-rt "(/ 20 5)") 4)
;; ── Chained comparison ──────────────────────────────────────────
(scm-rt-test "<: chained" (scm-rt "(< 1 2 3 4 5)") true)
(scm-rt-test "<: not strict" (scm-rt "(< 1 2 2 3)") false)
(scm-rt-test ">: chained" (scm-rt "(> 5 4 3 2 1)") true)
(scm-rt-test "<=: with equality" (scm-rt "(<= 1 1 2 3 3)") true)
(scm-rt-test "=: chained" (scm-rt "(= 7 7 7)") true)
;; ── Numerical ───────────────────────────────────────────────────
(scm-rt-test "abs neg" (scm-rt "(abs -5)") 5)
(scm-rt-test "abs pos" (scm-rt "(abs 5)") 5)
(scm-rt-test "min" (scm-rt "(min 3 1 4 1 5)") 1)
(scm-rt-test "max" (scm-rt "(max 3 1 4 1 5)") 5)
(scm-rt-test "modulo" (scm-rt "(modulo 10 3)") 1)
(scm-rt-test "zero? 0" (scm-rt "(zero? 0)") true)
(scm-rt-test "zero? 1" (scm-rt "(zero? 1)") false)
(scm-rt-test "positive?" (scm-rt "(positive? 5)") true)
(scm-rt-test "negative?" (scm-rt "(negative? -5)") true)
;; ── Type predicates ─────────────────────────────────────────────
(scm-rt-test "number? int" (scm-rt "(number? 42)") true)
(scm-rt-test "number? str" (scm-rt "(number? \"hi\")") false)
(scm-rt-test "boolean? #t" (scm-rt "(boolean? #t)") true)
(scm-rt-test "boolean? 0" (scm-rt "(boolean? 0)") false)
(scm-rt-test "string? str" (scm-rt "(string? \"hi\")") true)
(scm-rt-test "string? sym" (scm-rt "(string? 'foo)") false)
(scm-rt-test "symbol? sym" (scm-rt "(symbol? 'foo)") true)
(scm-rt-test "null? ()" (scm-rt "(null? '())") true)
(scm-rt-test "null? (1)" (scm-rt "(null? '(1))") false)
(scm-rt-test "pair? (1)" (scm-rt "(pair? '(1))") true)
(scm-rt-test "pair? ()" (scm-rt "(pair? '())") false)
(scm-rt-test "procedure? lambda" (scm-rt "(procedure? (lambda (x) x))") true)
(scm-rt-test "procedure? +" (scm-rt "(procedure? +)") true)
(scm-rt-test "procedure? 42" (scm-rt "(procedure? 42)") false)
(scm-rt-test "not #t" (scm-rt "(not #t)") false)
(scm-rt-test "not #f" (scm-rt "(not #f)") true)
(scm-rt-test "not 0" (scm-rt "(not 0)") false)
;; ── List operations ─────────────────────────────────────────────
(scm-rt-test
"cons"
(scm-rt "(cons 1 '(2 3))")
(list 1 2 3))
(scm-rt-test "car" (scm-rt "(car '(1 2 3))") 1)
(scm-rt-test "cdr" (scm-rt "(cdr '(1 2 3))") (list 2 3))
(scm-rt-test
"list builds"
(scm-rt "(list 1 2 3)")
(list 1 2 3))
(scm-rt-test "list empty" (scm-rt "(list)") (list))
(scm-rt-test "length 3" (scm-rt "(length '(a b c))") 3)
(scm-rt-test "length 0" (scm-rt "(length '())") 0)
(scm-rt-test
"reverse"
(scm-rt "(reverse '(1 2 3))")
(list 3 2 1))
(scm-rt-test "reverse empty" (scm-rt "(reverse '())") (list))
(scm-rt-test
"append two"
(scm-rt "(append '(1 2) '(3 4))")
(list 1 2 3 4))
(scm-rt-test
"append three"
(scm-rt "(append '(1) '(2) '(3))")
(list 1 2 3))
(scm-rt-test "append empty" (scm-rt "(append)") (list))
;; ── Higher-order combinators ────────────────────────────────────
(scm-rt-test
"map square"
(scm-rt "(map (lambda (x) (* x x)) '(1 2 3 4))")
(list 1 4 9 16))
(scm-rt-test
"map with primitive"
(scm-rt-all "(define inc (lambda (x) (+ x 1))) (map inc '(10 20 30))")
(list 11 21 31))
(scm-rt-test
"filter positives"
(scm-rt "(filter positive? '(-2 -1 0 1 2))")
(list 1 2))
(scm-rt-test
"filter empty result"
(scm-rt "(filter (lambda (x) #f) '(1 2 3))")
(list))
(scm-rt-test
"fold-left sum"
(scm-rt "(fold-left + 0 '(1 2 3 4 5))")
15)
(scm-rt-test
"fold-left build list"
(scm-rt "(fold-left (lambda (acc x) (cons x acc)) '() '(1 2 3))")
(list 3 2 1))
(scm-rt-test
"fold-right preserves order"
(scm-rt "(fold-right cons '() '(1 2 3))")
(list 1 2 3))
(scm-rt-test
"for-each side effect"
(let
((env (scheme-standard-env)))
(scheme-eval-program
(scheme-parse-all
"(define sum 0) (for-each (lambda (n) (set! sum (+ sum n))) '(1 2 3 4 5)) sum")
env))
15)
;; ── apply ───────────────────────────────────────────────────────
(scm-rt-test "apply +" (scm-rt "(apply + '(1 2 3 4 5))") 15)
(scm-rt-test
"apply lambda"
(scm-rt "(apply (lambda (a b c) (+ a (* b c))) '(1 2 3))")
7)
(scm-rt-test
"apply via map"
(scm-rt "(apply + (map (lambda (x) (* x x)) '(1 2 3)))")
14)
;; ── String / char / vector ──────────────────────────────────────
(scm-rt-test "string-length" (scm-rt "(string-length \"hello\")") 5)
(scm-rt-test "string=? same" (scm-rt "(string=? \"abc\" \"abc\")") true)
(scm-rt-test "string=? diff" (scm-rt "(string=? \"abc\" \"abd\")") false)
(scm-rt-test
"string-append"
(scheme-string-value (scm-rt "(string-append \"hello\" \" \" \"world\")"))
"hello world")
(scm-rt-test "vector?" (scm-rt "(vector? #(1 2 3))") true)
(scm-rt-test "vector-length" (scm-rt "(vector-length #(1 2 3))") 3)
(scm-rt-test "vector-ref" (scm-rt "(vector-ref #(10 20 30) 1)") 20)
(scm-rt-test
"vector->list"
(scm-rt "(vector->list #(1 2 3))")
(list 1 2 3))
;; ── Classic Scheme programs ─────────────────────────────────────
(scm-rt-test
"factorial 5"
(scm-rt-all
"(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 5)")
120)
(scm-rt-test
"factorial 10"
(scm-rt-all
"(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)")
3628800)
(scm-rt-test
"fib 10"
(scm-rt-all
"(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 10)")
55)
(scm-rt-test
"sum via reduce"
(scm-rt "(fold-left + 0 (map (lambda (x) (* x x)) '(1 2 3 4 5)))")
55)
(scm-rt-test
"length via reduce"
(scm-rt-all
"(define (len xs) (fold-left (lambda (acc _) (+ acc 1)) 0 xs)) (len '(a b c d))")
4)
(scm-rt-test
"Y-ish reverse"
(scm-rt-all
"(define (rev xs) (if (null? xs) '() (append (rev (cdr xs)) (list (car xs))))) (rev '(1 2 3 4))")
(list 4 3 2 1))
;; ── env-as-value (kit consumer demo) ────────────────────────────
(scm-rt-test
"env: standard-env is refl-env"
(refl-env? (scheme-standard-env))
true)
(scm-rt-test
"env: kit lookup finds primitive"
(let
((env (scheme-standard-env)))
(callable? (refl-env-lookup env "+")))
true)
(define scm-rt-tests-run! (fn () {:total (+ scm-rt-pass scm-rt-fail) :passed scm-rt-pass :failed scm-rt-fail :fails scm-rt-fails}))

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

@@ -0,0 +1,288 @@
;; 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")
;; ── let / let* ───────────────────────────────────────────────────
(scm-syn-test "let: returns body"
(scm-syn-eval "(let ((x 5)) (+ x 1))" (scm-syn-env)) 6)
(scm-syn-test "let: multiple bindings"
(scm-syn-eval "(let ((x 3) (y 4)) (+ x y))" (scm-syn-env)) 7)
(scm-syn-test "let: parallel (RHS sees outer)"
(let ((env (scm-syn-env)))
(scm-syn-eval-all "(define x 1) (let ((x 10) (y x)) y)" env)) 1)
(scm-syn-test "let: bindings don't leak"
(let ((env (scm-syn-env)))
(scm-syn-eval-all "(define x 1) (let ((x 99)) x) x" env)) 1)
(scm-syn-test "let*: sequential"
(scm-syn-eval "(let* ((x 1) (y (+ x 1)) (z (+ y 1))) z)"
(scm-syn-env)) 3)
(scm-syn-test "let*: shadow earlier"
(scm-syn-eval "(let* ((x 1) (x 2)) x)" (scm-syn-env)) 2)
;; ── cond / when / unless ─────────────────────────────────────────
(scm-syn-test "cond: first match"
(scm-syn-eval "(cond (#f 1) (#t 2) (#t 3))" (scm-syn-env)) 2)
(scm-syn-test "cond: else"
(scm-syn-eval "(cond (#f 1) (else 99))" (scm-syn-env)) 99)
(scm-syn-test "cond: untaken not evaluated"
(scm-syn-eval "(cond (#t 7) (nope ignored))" (scm-syn-env)) 7)
(scm-syn-test "cond: no match returns nil"
(scm-syn-eval "(cond (#f 1) (#f 2))" (scm-syn-env)) nil)
(scm-syn-test "cond: test-only clause"
(scm-syn-eval "(cond (42))" (scm-syn-env)) 42)
(scm-syn-test "when: true"
(scm-syn-eval "(when #t 1 2 3)" (scm-syn-env)) 3)
(scm-syn-test "when: false"
(scm-syn-eval "(when #f nope)" (scm-syn-env)) nil)
(scm-syn-test "unless: false"
(scm-syn-eval "(unless #f 42)" (scm-syn-env)) 42)
(scm-syn-test "unless: true"
(scm-syn-eval "(unless #t nope)" (scm-syn-env)) nil)
;; ── and / or ─────────────────────────────────────────────────────
(scm-syn-test "and: empty"
(scm-syn-eval "(and)" (scm-syn-env)) true)
(scm-syn-test "and: all truthy returns last"
(scm-syn-eval "(and 1 2 3)" (scm-syn-env)) 3)
(scm-syn-test "and: short-circuit on #f"
(scm-syn-eval "(and 1 #f nope)" (scm-syn-env)) false)
(scm-syn-test "or: empty"
(scm-syn-eval "(or)" (scm-syn-env)) false)
(scm-syn-test "or: first truthy"
(scm-syn-eval "(or #f 42 nope)" (scm-syn-env)) 42)
(scm-syn-test "or: all #f"
(scm-syn-eval "(or #f #f #f)" (scm-syn-env)) false)
(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}))

150
plans/scheme-on-sx.md Normal file
View File

@@ -0,0 +1,150 @@
# Scheme-on-SX: the reflective-kit second-consumer port
The kernel-on-sx loop documented six reflective API candidates; two are now live (`env.sx`, `class-chain.sx`). Three more — `evaluator.sx`, `hygiene.sx`, `quoting.sx` — wait on a guest with operative-free lexical scope, hygienic syntax-transformer infrastructure, and quasiquote. **Scheme is exactly that guest.**
A correct R7RS-small implementation acts as second consumer for those three kits in one stroke. It also confirms a third independent consumer for `env.sx` (after Kernel + Tcl + Smalltalk), and a candidate fourth consumer for `class-chain.sx` (Scheme's record types have parent fields — though OO is non-core in Scheme so the fit is weaker).
## Strategic note on `combiner.sx`
Scheme has *no fexprs*. `combiner.sx`'s applicative/operative split is Kernel-specific machinery. **Scheme is not a second consumer for `combiner.sx`** — that file stays Kernel-only until a Maru, Klisp, or CL-fexpr port arrives. The current session's earlier claim that Scheme "unlocks four more reflective kits" was over-counted; the correct number is **three**.
## Scope decisions
- **Target dialect:** R7RS-small. Source-only — no images, no FFI, no C extensions, no JIT.
- **Numbers:** integers + floats. Rationals optional (defer to phase N+1). Complex out.
- **Tail-call optimisation:** required. Implemented via the existing SX CEK machinery — call recursion in the evaluator uses iterative `cek-call` rather than host recursion.
- **Continuations:** `call/cc` required for R7RS. Use SX's `call/cc` primitive directly.
- **Hygienic macros:** `syntax-rules` required. `syntax-case` deferred.
- **Char/string semantics:** Unicode codepoints; surface API matches R7RS section 6.
- **I/O:** minimal stub (`display`, `write`, `newline`, `read`) on SX's IO surface.
- **`define-library`:** required for module testing; implementation reuses SX's `define-library` if it's exposed, else hand-rolls a flat module registry.
## Architecture sketch
```
lib/scheme/parser.sx — reader: numbers, strings, symbols, booleans,
chars #\c, vectors #(...), dotted-pairs (a . b),
quasi-quote sugar, datum comments #;, block
comments #| ... |#
lib/scheme/eval.sx — eval-expr ENV: walks AST. Symbols → env-lookup.
Lists → look up head; if syntactic operator
(if/lambda/define/set!/quote/quasiquote/
let/let*/letrec/begin/cond/case/and/or/when/
unless/do), dispatch to native handler. Else
apply combiner (always applicative).
ENV is `lib/guest/reflective/env.sx` directly
— Scheme is the third consumer for env.sx with
NO adapter cfg (canonical wire shape).
lib/scheme/runtime.sx — Standard environment, primitives, R7RS base.
Variadic arithmetic, list ops, string ops,
char ops, vector ops, define-record-type,
syntax-rules, etc.
lib/scheme/tests/ — Standard pattern: parse, eval, lambda+closure,
macros (syntax-rules), call/cc, define-library,
classic programs (factorial, Y, tree-walking,
named let, do-loop), R7RS conformance subset.
```
## Roadmap
### Phase 1 — Parser
- [ ] Reader for R7RS lexical syntax: integers, floats, strings (with escapes), symbols (extended-identifier-character set), booleans `#t`/`#f`/`#true`/`#false`, characters `#\c` `#\space` `#\newline`, vectors `#(...)`, dotted pairs `(a . b)`, quote/quasiquote/unquote/unquote-splicing sugar (same reader macros as Kernel).
- [ ] Datum comments `#;<datum>` (skip one whole expression).
- [ ] Block comments `#| ... |#` (nestable).
- [ ] Tests in `lib/scheme/tests/parse.sx`.
### Phase 2 — Evaluator + env
- [ ] `scheme-eval EXPR ENV` — primary entry, uses `lib/guest/reflective/env.sx` directly as the canonical scope chain. **Third consumer for env.sx.**
- [ ] Self-evaluating: numbers, booleans, strings, chars, vectors.
- [ ] Symbol lookup → `refl-env-lookup-with`.
- [ ] List → look up head; syntactic operators dispatch natively; otherwise applicative call with evaluated args.
- [ ] Tests in `lib/scheme/tests/eval.sx`.
### Phase 3 — Syntactic operators
- [ ] `if`, `quote`, `set!`, `define` (top-level + internal).
- [ ] `lambda` — fixed-arity, rest-arg via dot, multi-body via implicit `begin`.
- [ ] `let`, `let*`, `letrec`, `letrec*` — including named-let.
- [ ] `begin` — implicit + explicit.
- [ ] `cond`, `case`, `when`, `unless`, `and`, `or`, `do`.
- [ ] Tests for each.
### Phase 4 — Standard environment
- [ ] Variadic `+ - * /` and chained comparison.
- [ ] Type predicates (R7RS `number?`, `pair?`, `null?`, `symbol?`, `string?`, `procedure?`, `vector?`, `char?`, `boolean?`).
- [ ] List ops: `cons car cdr caar cadr ... cddddr` (or just a subset), `list length reverse append map filter fold-left fold-right for-each`.
- [ ] String ops: `string-length string-ref substring string-append string=? string<? char->integer integer->char`.
- [ ] Char ops: `char->integer integer->char char-alphabetic? char-numeric?` etc.
- [ ] Vector ops: `vector make-vector vector-length vector-ref vector-set! vector->list list->vector`.
- [ ] I/O: `display write newline read`.
- [ ] Numerical: `abs floor ceiling round truncate min max modulo quotient remainder gcd lcm expt`.
- [ ] Classic programs: factorial, fib, list reversal, tree map.
### Phase 5 — call/cc + dynamic-wind
- [ ] `call-with-current-continuation` / `call/cc`.
- [ ] `dynamic-wind`.
- [ ] `with-exception-handler`, `raise`, `error`.
- [ ] Tests: escape continuations, multi-shot via call/cc (chosen via host SX `call/cc`).
### Phase 6 — `syntax-rules` + hygiene
- [ ] `define-syntax`, `let-syntax`, `letrec-syntax`.
- [ ] `syntax-rules` pattern matching, ellipsis, template instantiation.
- [ ] Hygiene: scope-set / lifted-symbol implementation. **Second consumer for `lib/guest/reflective/hygiene.sx` extraction once that kit's API surface stabilises.**
- [ ] Tests: hygienic identifier capture, ellipsis patterns, recursive macros.
### Phase 7 — Reflection: `eval`, `interaction-environment`, etc.
- [ ] `eval EXPR ENV` — applicative form of the evaluator. **Second consumer for `lib/guest/reflective/evaluator.sx` extraction.**
- [ ] `interaction-environment`, `null-environment`, `scheme-report-environment`.
- [ ] `environment?` predicate.
### Phase 8 — `define-library` + module hygiene
- [ ] `define-library`, `import`, `export`.
- [ ] `cond-expand` for feature-flag conditionals.
- [ ] Tests: cross-library imports, identifier renaming.
### Phase 9 — Records
- [ ] `define-record-type` with constructor/predicate/accessors/mutators.
- [ ] Tests: typical record idioms.
### Phase 10 — Quasiquote runtime
- [ ] Backquote walker with depth tracking. **Second consumer for `lib/guest/reflective/quoting.sx` extraction.**
- [ ] Tests including nested quasiquote.
### Phase 11 — Conformance + scoreboard
- [ ] Curated R7RS test slice (Chibi, Larceny, or hand-picked).
- [ ] `lib/scheme/conformance.sh` + scoreboard.
- [ ] Drive conformance toward 100% on chosen slice.
## Reflective kit consumption — explicit mapping
| Kit | When it lands | How Scheme uses it |
|-----|--------------|-------------------|
| `lib/guest/reflective/env.sx` | Phase 2 | Direct — canonical wire shape, no cfg needed. Third consumer. |
| `lib/guest/reflective/evaluator.sx` | Phase 7 (will trigger the extraction) | Scheme's `eval`/`interaction-environment`/`null-environment` mirror the proposed `refl-eval`/`refl-make-environment`/`refl-current-env` triple. Second consumer → extraction unblocked. |
| `lib/guest/reflective/hygiene.sx` | Phase 6 | Scheme's hygienic `syntax-rules` is the canonical implementation of scope sets / lifted symbols. Second consumer for the deferred Shutt-style hygiene work — Scheme's hygiene goes BEYOND Kernel's by-default-static-env-extension into proper scope-set lifting. Drives the deferred research-grade kit. |
| `lib/guest/reflective/quoting.sx` | Phase 10 | Scheme's backquote walker is structurally identical to Kernel's `knl-quasi-walk`, with depth tracking added. Second consumer → extraction unblocked. |
| `lib/guest/reflective/combiner.sx` | NEVER (no fexprs) | Not applicable. Stays Kernel-only until a fexpr-having consumer arrives. |
| `lib/guest/reflective/short-circuit.sx` | Possibly Phase 3 | Scheme's `and`/`or` are syntactic, not operative; could be second consumer but adapter would need to bridge "macro that short-circuits" vs "operative that short-circuits". Marginal. |
## Ground rules
- **Scope:** only `lib/scheme/**` and `plans/scheme-on-sx.md` and `lib/guest/reflective/**` (for extraction work). Don't edit `spec/`, `hosts/`, `shared/`, or other `lib/<lang>/` directories.
- **Consume:** `lib/guest/lex.sx` (character predicates), `lib/guest/reflective/env.sx` (scope chain), eventually `evaluator.sx`/`hygiene.sx`/`quoting.sx` once extracted with Scheme as second consumer.
- **Commits:** one feature per commit. Short factual messages.
- **Tests:** every phase ends with a test file. Conformance scoreboard at the end.
- **Branch:** `loops/scheme`. Worktree pattern (already set up at `/root/rose-ash-loops/scheme`).
- **Substrate gaps:** filed to `sx-improvements.md`, not fixed in this loop.
## References
- R7RS-small: https://small.r7rs.org/attachment/r7rs.pdf
- Chibi Scheme — a small, readable R7RS implementation.
- Dybvig, "Three Implementation Models for Scheme" — for the hygiene story.
- Existing kernel-on-sx code in `lib/kernel/` — much of the parser, evaluator structure, and env handling carries over near-verbatim because Kernel and Scheme share lexical scope.
## Progress log
_(awaiting Phase 1)_