22 Commits

Author SHA1 Message Date
90cd0f8f6f plans: kernel-on-sx — log quoting.sx extraction + evaluator.sx decline
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Updates Phase 7 status:
- env.sx ✓ extracted (three live consumers: Kernel, Tcl, Smalltalk,
  with Scheme also using it directly)
- class-chain.sx ✓ extracted (bonus — not on the original six-file
  list but surfaced by the same chiselling discipline; Smalltalk +
  CLOS consumers)
- quoting.sx ✓ extracted (Kernel + Scheme consumers)
- evaluator.sx DECLINED — too thin to be its own kit; the shared
  content is protocol/API surface, not algorithm. Documented
  in-plan, no file created.
- combiner.sx, short-circuit.sx — still need fexpr-having
  second consumers
- hygiene.sx — still awaits Scheme Phase 6c (research-grade
  scope-set work)

Three kits live, one declined, three still gated.
2026-05-14 07:55:08 +00:00
818e68a2f8 reflective: extract quoting.sx — Kernel + Scheme share quasiquote walker
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
lib/guest/reflective/quoting.sx — quasiquote walker with adapter cfg.
Three forms:
- refl-quasi-walk-with CFG FORM ENV       (top-level)
- refl-quasi-walk-list-with CFG FORMS ENV (list walker, splice-aware)
- refl-quasi-list-concat XS YS            (pure-SX helper)

Adapter cfg keys:
- :unquote-name           — string keyword ("$unquote" or "unquote")
- :unquote-splicing-name  — string keyword
- :eval                   — fn (form env) → value

The shared algorithm is identical in Kernel and Scheme; the only
divergences are the keyword names (`$unquote` vs `unquote`) and
which host evaluator runs at unquote points (`kernel-eval` vs
`scheme-eval`). Both surface through the cfg.

Migrations:
- lib/kernel/runtime.sx: knl-quasi-walk reduces to a 3-line wrapper
  that builds knl-quasi-cfg and delegates. Removed knl-quasi-walk-
  list + knl-list-concat (~40 LoC) — now provided by the kit.
- lib/scheme/eval.sx: scm-quasi-walk reduces to a 3-line wrapper
  around scm-quasi-cfg. Removed scm-quasi-walk-list + scm-list-
  concat. scm-collect-exports (module impl) was a hidden consumer
  of scm-list-concat — rewired to refl-quasi-list-concat.

lib/scheme/test.sh — loads lib/guest/reflective/quoting.sx before
lib/scheme/parser.sx so the kit is available when eval.sx loads.

Both consumers' tests green:
- Kernel: 322 tests across 7 suites
- Scheme: 296 tests across 9 suites

**Second reflective-kit extraction landed.** The kit-extraction
playbook from env.sx and class-chain.sx — adapter-cfg pattern from
lib/guest/match.sx, same algorithm bridges different keyword names —
works again on a third structurally different problem (quasiquote
walking). The cumulative extraction story: env.sx → class-chain.sx
→ quoting.sx, three independent kits, all using the same pattern.

`evaluator.sx` (the other deferred candidate the Scheme port
unlocked) is NOT extracted — the genuinely shared content is too
thin (one helper for closure-capturing interaction-environment).
The eval-protocol is more about API surface than algorithm.
Documented as a non-extraction.
2026-05-14 07:54:15 +00:00
26112f1003 plans: scheme-on-sx progress log — 11 phases done, 296 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
Loop closer documenting what 10 feature commits landed across the
session. Phase-by-phase outcomes captured, including the SX cond
multi-expression bug found and fixed during Phase 4.

Chisel ledger:
- env.sx already EXTRACTED with Scheme as third consumer
- evaluator.sx + quoting.sx second-consumer-ready for follow-on
  kit-extraction commits
- hygiene.sx still awaits the deferred Phase 6c (scope-set work)
- combiner.sx and short-circuit.sx don't apply (Scheme has no
  fexprs and uses syntactic and/or)

Deferred phases listed: full hygiene, nested quasi-depth, R7RS
module rich features, dotted-pair syntax, full call/cc-wind
interaction.

Loop's defining feature: lib/guest CHISELLING discipline — every
commit had a chisel note, and the cumulative work satisfies the
two-consumer rule for three new kit extractions.
2026-05-14 06:53:36 +00:00
680cdf62aa scheme: Phase 11 — test.sh + scoreboard
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
lib/scheme/test.sh — single-process test runner. Loads parser/eval/
runtime + lib/guest/reflective/env.sx once, then for each test
suite loads its file and calls its (*-tests-run!) function. Parses
the {:passed N :failed N ...} dict output and aggregates.

Usage:
  bash lib/scheme/test.sh        # summary
  bash lib/scheme/test.sh -v     # per-suite breakdown

Output: "ok 296/296 scheme-on-sx tests passed (9 suites)"

lib/scheme/scoreboard.md — per-suite passing counts, phase status,
deferred items, reflective-kit consumption ledger.

The scoreboard documents the chisel value of the Scheme port:
three reflective kits unlocked (env.sx — already extracted with
Scheme as third consumer; evaluator.sx + quoting.sx — second-
consumer-ready for extraction whenever a follow-up commit is run).

Loop status: 11 phases done (1, 2, 3, 3.5, 4, 5abc, 6ab, 7, 8, 9,
10, 11). Two deferred (6c hygiene, full call/cc-wind interaction).

296 tests, 1830 LoC of Scheme implementation. Zero substrate fixes
required across the loop.
2026-05-14 06:52:58 +00:00
7e795f95fc scheme: Phase 8 — define-library + import (minimal) + 7 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
eval.sx adds module support:

  (define-library NAME EXPR...)
    Where EXPR is one of:
      (export NAME ...)
      (import LIB-NAME ...)
      (begin BODY ...)

  (import LIB-NAME ...)
    Looks up each library by key, copies its exported names
    into the current env.

Library values: {:scm-tag :library :name :exports :env}
Stored in scheme-library-registry keyed by joined library-name
(`(my math)` → `"my/math"`).

Library body runs in a FRESH standard env (each library is its
own namespace). Only :exports are visible after import; private
internal definitions stay in the library's env. Internal calls
between library functions use the library's env, so public-facing
exports can rely on private helpers.

Multiple imports work — each library is independent.

NOT yet supported: cond-expand, include, include-library-
declarations, renaming (`(only ...)`, `(except ...)`, `(prefix ...)`,
`(rename ...)`). Standard R7RS modules use these but the core
two-operation flow (define-library / import) covers most everyday
module use.

7 tests: single export, multi-export, private-not-visible,
internal-calls-private, two-libs-both-imported, unknown-lib-error,
single-symbol library name.

296 total Scheme tests (62+23+49+78+25+20+13+10+9+7).

Phases done: 1, 2, 3, 3.5, 4, 5abc, 6ab, 7, 8, 9, 10.
Deferred: 6c (hygiene/scope-set — research-grade), 11 (conformance).
2026-05-14 06:50:58 +00:00
f927fb6515 scheme: Phase 9 — define-record-type + 9 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
eval.sx adds the define-record-type syntactic operator:

  (define-record-type NAME
    (CONSTRUCTOR ARG...)
    PREDICATE
    (FIELD ACCESSOR [MUTATOR])...)

Records are tagged dicts:
  {:scm-record TYPE-NAME :fields {FIELD VALUE ...}}

For each record type, the operator binds:
- Constructor: takes the listed ARGs, populates :fields, returns
  the record. Fields not in CONSTRUCTOR ARGs default to nil.
- Predicate: returns true iff its arg is a record of THIS type
  (tag-match via :scm-record).
- Accessor per field: extracts the field value; errors if not
  a record of the right type.
- Mutator per field (optional): sets the field via dict-set!;
  same type-check.

Distinct types are isolated via their tag — point? returns false
on a circle, even if both have the same shape.

9 tests cover: constructor + predicate + accessors, mutator,
distinct-types-via-tag, records as first-class values (in lists,
passed to map/filter), constructor arity errors.

289 total Scheme tests (62+23+49+78+25+20+13+10+9).
2026-05-14 06:49:24 +00:00
e200935698 scheme: Phase 10 — quasiquote runtime + 10 tests [shapes-reflective]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
eval.sx adds quasiquote / unquote / unquote-splicing as syntactic
operators with the canonical R7RS walker:

- (quasiquote X) — top-level entry to scm-quasi-walk
- (unquote X) — at depth-0, evaluates X in env
- (unquote-splicing X) — inside a list, splices X's list value
- Reader-macro sugar: `X / ,X / ,@X work via Phase 1 parser

Algorithm identical to lib/kernel/runtime.sx's knl-quasi-walk:
- Walk template recursively
- Non-list: pass through
- ($unquote/unquote X) head form: eval X
- Inside a list, ($unquote-splicing/unquote-splicing X) head:
  eval X, splice list into surrounding context
- Otherwise: recurse on each element

No depth-tracking yet — nested quasiquotes are not properly
handled (matches Kernel's deferred state).

10 tests: plain atom/list, unquote substitution, splicing at
start/middle/end, nested list with unquote, unquote evaluates
expression, error on non-list splice, error on bare unquote.

**Second consumer for lib/guest/reflective/quoting.sx unlocked.**
Both Kernel and Scheme have structurally identical walkers; the
extraction would parameterise just the unquote/splicing keyword
names (Kernel uses $unquote / $unquote-splicing; Scheme uses
unquote / unquote-splicing — pure cfg, no algorithmic change).

280 total Scheme tests (62+23+49+78+25+20+13+10).

Three reflective-kit extractions unlocked in this Scheme port:
- env.sx        — Phase 2 (consumed directly, third overall consumer)
- evaluator.sx  — Phase 7 (second consumer via eval/interaction-env)
- quoting.sx    — Phase 10 (second consumer via scm-quasi-walk)

The kit extractions themselves remain follow-on commits when
desired. hygiene.sx still awaits a real second consumer
(Scheme phase 6c with scope-set algorithm).
2026-05-14 06:47:51 +00:00
342e1a2ccf scheme: Phase 7 — eval/interaction-environment/null-env + 13 tests [shapes-reflective]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
runtime.sx binds R7RS reflective primitives:
- eval EXPR ENV
- interaction-environment        — returns env captured by closure
- null-environment VERSION       — fresh empty env (ignores version)
- scheme-report-environment N    — fresh full standard env
- environment? V

interaction-environment closes over the standard env being built;
each invocation of scheme-standard-env produces a distinct
interaction env that returns ITSELF when queried — so user-side
(define name expr) inside (eval ... (interaction-environment))
persists for subsequent (eval 'name ...) lookups.

13 tests cover:
- eval over quoted forms (literal + constructed via list)
- define-then-lookup through interaction-environment
- eqv? identity of interaction-environment across calls
- sandbox semantics: eval in null-environment errors on +
- scheme-report-environment is fresh and distinct from interaction

**Second consumer for lib/guest/reflective/evaluator.sx unlocked.**
Scheme's eval/interaction-environment/null-environment triple is
the same protocol Kernel exposes via eval-applicative /
get-current-environment / make-environment. Extraction now
satisfies the two-consumer rule — same playbook as env.sx and
class-chain.sx, awaits a follow-up commit to actually extract
the kit.

270 total Scheme tests (62 + 23 + 49 + 78 + 25 + 20 + 13).
2026-05-14 06:45:39 +00:00
9a7ca54902 scheme: Phase 6b — syntax-rules ellipsis (tail-rest) + 8 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
scm-match-list now detects `<pat> ...` at the END of a pattern list
and binds <pat> (must be a symbol — single-variable rest) to the
remaining forms as a list. Nested-list patterns under ellipsis and
middle-of-list ellipses are NOT supported yet (rare in practice;
deferred).

scm-instantiate-list mirrors: when it encounters `<var> ... `
inside a list template, it splices the list-valued binding of <var>
in place. Internal list-append-all helper for the splice.

Removes the `(length pat) = (length form)` strict-equality check
in scm-match-step's list case — that gate blocked ellipsis. The
length-1-or-more relaxed check now lives in scm-match-list itself.

8 ellipsis tests cover:
- Empty rest (my-list)
- Non-empty rest (my-list 1 2 3 4)
- my-when with multi-body
- Variadic sum-em via fold-left
- Recursive my-and pattern (short-circuit AND defined as macro)

257 total Scheme tests (62 + 23 + 49 + 78 + 25 + 20).

Phase 6c (proper hygiene) is the next step and will be the
**second consumer for lib/guest/reflective/hygiene.sx** — the
deferred research-grade kit from the kernel-on-sx loop.
2026-05-14 06:43:20 +00:00
eb14a7576b scheme: Phase 6a — define-syntax + syntax-rules (no ellipsis) + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
eval.sx adds macro infrastructure:
- {:scm-tag :macro :literals (LIT...) :rules ((PAT TMPL)...) :env E}
- scheme-macro? predicate
- scm-match / scm-match-list — pattern matching against literals,
  pattern variables, and structural list shapes
- scm-instantiate — template substitution with bindings
- scm-expand-rules — try each rule in order
- (syntax-rules (LITS) (PAT TMPL)...) → macro value
- (define-syntax NAME FORM) → bind macro in env
- scheme-eval: when head looks up to a macro, expand and re-eval

Pattern matching supports:
- _ → match anything, no bind
- literal symbols from the LITERALS list → must equal-match
- other symbols → pattern variables, bind to matched form
- list patterns → must be same length, each element matches

NO ellipsis (`...`) support yet — that's Phase 6b. NO hygiene
yet (introduced symbols can shadow caller bindings) — that's
Phase 6c, which will be the second consumer for
lib/guest/reflective/hygiene.sx.

12 tests cover: simple substitution, multi-rule selection,
nested macro use, swap-idiom (state mutation via set!), control-
flow wrappers, literal-keyword pattern matching, macros inside
lambdas.

249 total Scheme tests now (62 + 23 + 49 + 78 + 25 + 12).
2026-05-14 06:41:11 +00:00
a90f56e3f3 scheme: Phase 5c — dynamic-wind (basic, no call/cc tracking) + 5 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
(dynamic-wind BEFORE THUNK AFTER)
  - Calls BEFORE; runs THUNK; calls AFTER; returns THUNK's value.
  - If THUNK raises, AFTER still runs before the raise propagates.
  - Implementation: outcome-sentinel pattern (same trick as guard
    and with-exception-handler) — catch THUNK's raise inside a
    host guard, run AFTER unconditionally, then either return the
    value or re-raise outside the catch.

Not implemented: call/cc-escape tracking. R7RS specifies that
dynamic-wind's BEFORE and AFTER thunks should re-run when control
re-enters or exits the dynamic extent via continuations. That
requires explicit dynamic-extent stack tracking, deferred until
a consumer needs it (probably never needed for pure-eval Scheme
programs; matters for first-class-continuation-heavy code).

5 tests: success ordering, return value, after-on-raise,
raise propagation, nested wind.

237 total Scheme tests now (62 + 23 + 49 + 78 + 25).
2026-05-14 06:37:51 +00:00
55c376f559 scheme: Phase 5b — R7RS exceptions (raise/guard/with-exception-handler) + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
eval.sx adds the `guard` syntactic operator with R7RS-compliant
clause dispatch: var binds to raised value in a fresh child env;
clauses tried in order; `else` is catch-all; no match re-raises.

Implementation uses a "catch-once-then-handle-outside" pattern to
avoid the handler self-raise loop:
  outcome = host-guard {body}            ;; tag raise vs success
  if outcome was raise:
    try clauses → either result or sentinel
    if sentinel: re-raise OUTSIDE the host-guard scope

runtime.sx binds R7RS exception primitives:
- raise V
- error MSG IRRITANT...  → {:scm-error MSG :irritants LIST}
- error-object?, error-object-message, error-object-irritants
- with-exception-handler HANDLER THUNK
  (same outcome-sentinel pattern — handler's own raises propagate
  outward instead of re-entering)

12 tests cover: catch on raise, predicate dispatch, else catch-all,
no-error pass-through, first-clause-wins, re-raise-on-no-match,
error-object construction and accessors.

232 total Scheme tests now (62 + 23 + 49 + 78 + 20).
2026-05-14 06:36:50 +00:00
e3e5d3e888 scheme: Phase 5a — call/cc + 8 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
scheme-standard-env binds:
- call/cc                            — primary
- call-with-current-continuation     — alias

Implementation wraps SX's host call/cc, presenting the captured
continuation k as a Scheme procedure that accepts a single value
(or a list of values for multi-arg invocation). Single-shot
escape semantics: when k is invoked, control jumps out of the
surrounding call/cc form. Multi-shot re-entry isn't safely
testable without delimited-continuation infrastructure (the
captured continuation re-enters indefinitely if invoked after
the call/cc returns) — deferred to a follow-up commit if needed.

Tests cover:
- No-escape return value
- Escape past arithmetic frames
- Detect/early-exit idiom over for-each
- Procedure? on the captured k

220 total Scheme tests now (62 + 23 + 49 + 78 + 8).
2026-05-14 06:27:03 +00:00
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
9efbf4ad38 reflective: third consumer — Smalltalk frame adopts env.sx — 847+322+427 tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
lib/guest/reflective/env.sx — added refl-env-find-frame-with (returns
the scope where NAME is bound, or nil). Needed by consumers like
Smalltalk that mutate variables at the source frame rather than
shadowing at the current one. Also added refl-env-find-frame for
the canonical shape.

lib/smalltalk/eval.sx — new st-frame-cfg adapter for the kit.
st-lookup-local now delegates parent-walk to refl-env-find-frame-with
while preserving its Smalltalk-flavoured {:found :value :frame}
return shape (which is used to mutate at the binding's source
frame, not the current one).

lib/smalltalk/test.sh + compare.sh — load lib/guest/reflective/env.sx
before lib/smalltalk/eval.sx.

Three genuinely different wire shapes now share the parent-walk:
- Kernel: {:refl-tag :env :bindings :parent}      mutable bindings
- Tcl:    {:level :locals :parent}                 functional update
- Smalltalk: {:self :method-class :locals :parent  mutable bindings,
              :return-k :active-cell}              rich metadata

All three consumers' full test suites unchanged: Smalltalk 847/847,
Kernel 322/322, Tcl 427/427. The cfg adapter pattern (modelled after
lib/guest/match.sx) cleanly handles all three.
2026-05-12 15:19:19 +00:00
4e904a2782 merge: loops/smalltalk into lib/smalltalk/refl-env — bring in third consumer 2026-05-12 14:50:05 +00:00
6fa0cdeedc briefing: push to origin/loops/smalltalk after each commit
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
2026-05-06 06:47:30 +00:00
23 changed files with 3630 additions and 51 deletions

View File

@@ -42,6 +42,9 @@
;; (refl-env-has?-with CFG SCOPE NAME) ;; (refl-env-has?-with CFG SCOPE NAME)
;; (refl-env-lookup-with CFG SCOPE NAME) ;; (refl-env-lookup-with CFG SCOPE NAME)
;; (refl-env-lookup-or-nil-with CFG SCOPE NAME) ;; (refl-env-lookup-or-nil-with CFG SCOPE NAME)
;; (refl-env-find-frame-with CFG SCOPE NAME)
;; — returns the scope in the chain that contains NAME (or nil).
;; Consumers needing source-frame mutation use this.
;; ;;
;; (refl-canonical-cfg) — the default cfg, exposed so consumers ;; (refl-canonical-cfg) — the default cfg, exposed so consumers
;; can compare or extend it. ;; can compare or extend it.
@@ -131,6 +134,24 @@
(:else (:else
(refl-env-lookup-or-nil-with cfg ((get cfg :parent-of) scope) name))))) (refl-env-lookup-or-nil-with cfg ((get cfg :parent-of) scope) name)))))
;; Returns the SCOPE in the chain that contains NAME, or nil if no
;; scope binds it. Consumers (e.g. Smalltalk) use this to mutate the
;; binding at its source frame rather than introducing a new shadow
;; binding at the current frame. Pairs with `refl-env-lookup-with`
;; for callers that need both the value and the defining scope.
(define refl-env-find-frame-with
(fn (cfg scope name)
(cond
((nil? scope) nil)
((not ((get cfg :env?) scope)) nil)
((dict-has? ((get cfg :bindings-of) scope) name) scope)
(:else
(refl-env-find-frame-with cfg ((get cfg :parent-of) scope) name)))))
(define refl-env-find-frame
(fn (env name) (refl-env-find-frame-with refl-canonical-cfg env name)))
;; ── Default canonical cfg ─────────────────────────────────────── ;; ── Default canonical cfg ───────────────────────────────────────
;; Exposed so consumers can use it explicitly, compose with it, or ;; Exposed so consumers can use it explicitly, compose with it, or
;; check adapter-correctness against the canonical implementation. ;; check adapter-correctness against the canonical implementation.

View File

@@ -0,0 +1,77 @@
;; lib/guest/reflective/quoting.sx — quasiquote walker.
;;
;; Extracted from Kernel's `knl-quasi-walk` and Scheme's `scm-quasi-walk`,
;; which differ only in:
;; - the unquote keyword name (Kernel: "$unquote" / "$unquote-splicing";
;; Scheme: "unquote" / "unquote-splicing")
;; - the host evaluator function (`kernel-eval` vs `scheme-eval`)
;;
;; Algorithm is identical. Adapter cfg parameterises the two
;; language-specific knobs.
;;
;; Adapter cfg keys
;; ----------------
;; :unquote-name — string, name of the unquote keyword
;; :unquote-splicing-name — string, name of the splice keyword
;; :eval — fn (form env) → value
;;
;; Public API
;; (refl-quasi-walk-with CFG FORM ENV)
;; Top-level walker. Returns FORM with unquotes evaluated in ENV.
;;
;; (refl-quasi-walk-list-with CFG FORMS ENV)
;; Walks a list of forms, splicing unquote-splicing results inline.
;;
;; (refl-quasi-list-concat XS YS)
;; Pure-SX list append (no host append/append! needed).
(define
refl-quasi-list-concat
(fn
(xs ys)
(cond
((or (nil? xs) (= (length xs) 0)) ys)
(:else (cons (first xs) (refl-quasi-list-concat (rest xs) ys))))))
(define
refl-quasi-walk-with
(fn
(cfg form env)
(cond
((not (list? form)) form)
((= (length form) 0) form)
((and (string? (first form)) (= (first form) (get cfg :unquote-name)))
(cond
((not (= (length form) 2))
(error
(str (get cfg :unquote-name) ": expects exactly 1 argument")))
(:else ((get cfg :eval) (nth form 1) env))))
(:else (refl-quasi-walk-list-with cfg form env)))))
(define
refl-quasi-walk-list-with
(fn
(cfg forms env)
(cond
((or (nil? forms) (= (length forms) 0)) (list))
(:else
(let
((head (first forms)))
(cond
((and (list? head) (= (length head) 2) (string? (first head)) (= (first head) (get cfg :unquote-splicing-name)))
(let
((spliced ((get cfg :eval) (nth head 1) env)))
(cond
((not (list? spliced))
(error
(str
(get cfg :unquote-splicing-name)
": value must be a list")))
(:else
(refl-quasi-list-concat
spliced
(refl-quasi-walk-list-with cfg (rest forms) env))))))
(:else
(cons
(refl-quasi-walk-with cfg head env)
(refl-quasi-walk-list-with cfg (rest forms) env)))))))))

View File

@@ -194,48 +194,18 @@
((not (= (length args) 1)) (error "$quote: expects 1 argument")) ((not (= (length args) 1)) (error "$quote: expects 1 argument"))
(:else (first args)))))) (:else (first args))))))
;; Quasiquote: walks the template, evaluating `$unquote` forms in the ;; Kernel-side adapter for lib/guest/reflective/quoting.sx.
;; dynamic env and splicing `$unquote-splicing` list results. ;; Kernel uses $unquote / $unquote-splicing (dollar-prefixed) and the
;; host-level kernel-eval as the evaluator. The walker algorithm
;; itself is shared with Scheme via the kit.
(define knl-quasi-cfg
{:unquote-name "$unquote"
:unquote-splicing-name "$unquote-splicing"
:eval (fn (form env) (kernel-eval form env))})
(define knl-quasi-walk (define knl-quasi-walk
(fn (form dyn-env) (fn (form dyn-env)
(cond (refl-quasi-walk-with knl-quasi-cfg form dyn-env)))
((not (list? form)) form)
((= (length form) 0) form)
((and (string? (first form)) (= (first form) "$unquote"))
(cond
((not (= (length form) 2))
(error "$unquote: expects exactly 1 argument"))
(:else (kernel-eval (nth form 1) dyn-env))))
(:else (knl-quasi-walk-list form dyn-env)))))
(define knl-quasi-walk-list
(fn (forms dyn-env)
(cond
((or (nil? forms) (= (length forms) 0)) (list))
(:else
(let ((head (first forms)))
(cond
((and (list? head)
(= (length head) 2)
(string? (first head))
(= (first head) "$unquote-splicing"))
(let ((spliced (kernel-eval (nth head 1) dyn-env)))
(cond
((not (list? spliced))
(error "$unquote-splicing: value must be a list"))
(:else
(knl-list-concat
spliced
(knl-quasi-walk-list (rest forms) dyn-env))))))
(:else
(cons (knl-quasi-walk head dyn-env)
(knl-quasi-walk-list (rest forms) dyn-env)))))))))
(define knl-list-concat
(fn (xs ys)
(cond
((or (nil? xs) (= (length xs) 0)) ys)
(:else (cons (first xs) (knl-list-concat (rest xs) ys))))))
;; $cond — multi-clause branch. ;; $cond — multi-clause branch.
;; ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...) ;; ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)

1009
lib/scheme/eval.sx Normal file

File diff suppressed because it is too large Load Diff

BIN
lib/scheme/parser.sx Normal file

Binary file not shown.

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

@@ -0,0 +1,649 @@
;; 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))))
;; ── call/cc (R7RS first-class continuations) ────────────
;; Captures the host SX continuation, wraps it as a Scheme
;; procedure (fn (vargs) ...) and passes it to the user proc.
;; Calling the captured k with one value re-enters the
;; continuation; with multiple values, passes them as a list.
(scheme-env-bind! env "call/cc"
(fn (args)
(cond
((not (= (length args) 1))
(error "call/cc: expects 1 argument"))
(:else
(call/cc
(fn (k)
(let ((scheme-k
(fn (vargs)
(cond
((= (length vargs) 1) (k (first vargs)))
(:else (k vargs))))))
(scheme-apply (first args) (list scheme-k)))))))))
(scheme-env-bind! env "call-with-current-continuation"
(refl-env-lookup env "call/cc"))
;; ── R7RS exception primitives ──────────────────────────
;; raise V — raises V as exception (host SX raise).
(scheme-env-bind! env "raise"
(fn (args)
(cond
((not (= (length args) 1))
(error "raise: expects 1 argument"))
(:else (raise (first args))))))
;; error MSG IRRITANTS... — convention: raise an error-object
;; that's a dict {:scm-error MSG :irritants LIST}. The print
;; surface (error-object-message / error-object-irritants)
;; can pull these apart.
(scheme-env-bind! env "error"
(fn (args)
(cond
((= (length args) 0) (error "error: expects (message [irritant...])"))
(:else
(raise {:scm-error (cond
((scheme-string? (first args))
(scheme-string-value (first args)))
(:else (first args)))
:irritants (rest args)})))))
(scheme-env-bind! env "error-object?"
(scm-unary "error-object?"
(fn (v) (and (dict? v) (string? (get v :scm-error))))))
(scheme-env-bind! env "error-object-message"
(scm-unary "error-object-message"
(fn (v) (scheme-string-make (get v :scm-error)))))
(scheme-env-bind! env "error-object-irritants"
(scm-unary "error-object-irritants"
(fn (v) (get v :irritants))))
;; with-exception-handler HANDLER THUNK — runs THUNK; if it
;; raises, calls HANDLER with the raised value (handler can
;; itself raise or return a value). Implemented via host guard.
;; with-exception-handler — catch THUNK's raise; if caught,
;; call HANDLER. If HANDLER itself raises, propagate that to
;; the outer scope (don't re-catch in this same guard, which
;; would loop). The two-step outcome-sentinel pattern mirrors
;; the `guard` special form's escape.
(scheme-env-bind! env "with-exception-handler"
(fn (args)
(cond
((not (= (length args) 2))
(error "with-exception-handler: expects 2 arguments"))
(:else
(let ((handler (first args))
(thunk (nth args 1)))
(let ((outcome
(guard
(e (true {:scm-weh-raised true :value e}))
(scheme-apply thunk (list)))))
(cond
((and (dict? outcome) (get outcome :scm-weh-raised))
(scheme-apply handler (list (get outcome :value))))
(:else outcome))))))))
;; ── R7RS reflection: eval / environment accessors ───────
;; eval EXPR ENV — apply the evaluator to a user-supplied AST.
(scheme-env-bind! env "eval"
(fn (args)
(cond
((not (= (length args) 2))
(error "eval: expects (eval expr env)"))
(:else (scheme-eval (first args) (nth args 1))))))
;; interaction-environment — the env we're currently building.
;; The closure captures `env`, so each invocation of
;; scheme-standard-env produces a distinct interaction env
;; whose interaction-environment fn returns itself.
(scheme-env-bind! env "interaction-environment"
(fn (args)
(cond
((not (= (length args) 0))
(error "interaction-environment: expects 0 args"))
(:else env))))
;; null-environment — fresh empty env. R7RS ignores version arg.
(scheme-env-bind! env "null-environment"
(fn (args)
(cond
((not (= (length args) 1))
(error "null-environment: expects (version)"))
(:else (scheme-make-env)))))
;; scheme-report-environment — fresh full standard env.
(scheme-env-bind! env "scheme-report-environment"
(fn (args)
(cond
((not (= (length args) 1))
(error "scheme-report-environment: expects (version)"))
(:else (scheme-standard-env)))))
(scheme-env-bind! env "environment?"
(scm-unary "environment?" (fn (v) (scheme-env? v))))
;; dynamic-wind BEFORE THUNK AFTER — runs BEFORE, then THUNK,
;; then AFTER. If THUNK raises, AFTER still runs before the
;; raise propagates. This is the basic-correctness version;
;; proper call/cc-escape interaction would need dynamic-extent
;; tracking, deferred until needed.
(scheme-env-bind! env "dynamic-wind"
(fn (args)
(cond
((not (= (length args) 3))
(error "dynamic-wind: expects (before thunk after)"))
(:else
(let ((before-thunk (first args))
(mid-thunk (nth args 1))
(after-thunk (nth args 2)))
(begin
(scheme-apply before-thunk (list))
(let ((outcome
(guard
(e (true {:scm-dw-raised true :value e}))
(scheme-apply mid-thunk (list)))))
(begin
(scheme-apply after-thunk (list))
(cond
((and (dict? outcome) (get outcome :scm-dw-raised))
(raise (get outcome :value)))
(:else outcome))))))))))
env)))

83
lib/scheme/scoreboard.md Normal file
View File

@@ -0,0 +1,83 @@
# Scheme-on-SX Scoreboard
**All tests pass: 296 / 296 across 9 suites.**
## Per-suite breakdown
| Suite | Passing | Covers |
|-------------|--------:|--------|
| parse | 62 | R7RS lexer: numbers, strings, chars, vectors, lists, quote/quasi/unquote, line/block/datum comments |
| eval | 23 | Self-evaluating literals, symbol lookup, quote, primitive application |
| syntax | 49 | if/define/set!/begin/lambda/closures + let/let*/cond/when/unless/and/or |
| runtime | 78 | Standard env: variadic arithmetic, type predicates, list/string/char/vector ops, higher-order combinators |
| control | 25 | call/cc (escape), raise/guard/with-exception-handler, dynamic-wind |
| macros | 20 | define-syntax / syntax-rules incl. tail-rest ellipsis |
| reflection | 23 | eval / interaction-environment / null-environment / scheme-report-environment + quasiquote runtime |
| records | 9 | define-record-type with constructor / predicate / accessor / mutator |
| modules | 7 | define-library + import (minimal — no cond-expand / include / rename) |
## Phases implemented
- [x] Phase 1 — Parser
- [x] Phase 2 — Evaluator + env.sx **third consumer**
- [x] Phase 3 — Syntactic operators (if/lambda/define/set!/begin)
- [x] Phase 3.5 — let/let*/cond/when/unless/and/or
- [x] Phase 4 — Standard environment + set! cond-bugfix
- [x] Phase 5a — call/cc
- [x] Phase 5b — exceptions (raise/guard/with-exception-handler/error)
- [x] Phase 5c — dynamic-wind (basic, no call/cc-escape tracking)
- [x] Phase 6a — define-syntax + syntax-rules (no ellipsis)
- [x] Phase 6b — syntax-rules ellipsis (tail-rest, single variable)
- [x] Phase 7 — eval / interaction-environment **second consumer for evaluator.sx**
- [x] Phase 8 — define-library + import (minimal)
- [x] Phase 9 — define-record-type
- [x] Phase 10 — quasiquote runtime **second consumer for quoting.sx**
- [x] Phase 11 — test.sh + scoreboard
## Deferred
- **Phase 6c — hygiene** (scope-set / lifted-symbol Dybvig-style algorithm).
Would be the second consumer for the deferred `lib/guest/reflective/hygiene.sx`
research-grade kit. Current macros work for common patterns but can capture
caller bindings if a macro introduces same-named identifiers.
- **Nested quasiquote depth tracking** — `` `\`x\` `` is not properly depth-aware;
matches Kernel's deferred state.
- **R7RS module rich features**: cond-expand, include, include-library-declarations,
`(only ...)` / `(except ...)` / `(prefix ...)` / `(rename ...)` import sets.
- **Dotted-pair `(a b . rest)` syntax** at the parser level. Lambda rest-args
currently use the `(lambda args ...)` form (bare symbol) instead.
- **Full call/cc + dynamic-wind interaction**: re-entry/re-exit of dynamic
extents via continuations is not tracked. Pure-eval programs work; call/cc-
heavy code with dynamic-wind interleaving doesn't.
## Reflective-kit consumption (chisel ledger)
This Scheme port unlocks three reflective-kit extractions from the kernel-on-sx
loop's original six-candidate list:
| Kit | Status |
|----------------------|---------------------------------------------|
| env.sx | **Extracted** (third consumer; no adapter) |
| class-chain.sx | n/a (no OO in Scheme) |
| evaluator.sx | **Unblocked** (second consumer ready) |
| quoting.sx | **Unblocked** (second consumer ready) |
| hygiene.sx | Awaiting Phase 6c (research-grade) |
| combiner.sx | n/a (no fexprs in Scheme) |
| short-circuit.sx | n/a (Scheme `and`/`or` are syntactic, not operative) |
The kit-extraction commits themselves are follow-on work — kit code is staged
in the proposed sections of `plans/kernel-on-sx.md`; Scheme's consumer code
satisfies the two-consumer rule for `evaluator.sx` and `quoting.sx`.
## Substrate stats
- parser.sx — 281 LoC
- eval.sx — ~970 LoC
- runtime.sx — ~580 LoC
- Tests — ~1500 LoC across 9 files
Total Scheme implementation ≈ 1830 LoC.

93
lib/scheme/test.sh Executable file
View File

@@ -0,0 +1,93 @@
#!/usr/bin/env bash
# Scheme-on-SX test runner — runs all tests in one sx_server process.
#
# Usage:
# bash lib/scheme/test.sh # run all suites
# bash lib/scheme/test.sh -v # verbose (list each suite)
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
# Suites: NAME RUNNER-FN PATH
SUITES=(
"parse scm-tests-run! lib/scheme/tests/parse.sx"
"eval scm-eval-tests-run! lib/scheme/tests/eval.sx"
"syntax scm-syn-tests-run! lib/scheme/tests/syntax.sx"
"runtime scm-rt-tests-run! lib/scheme/tests/runtime.sx"
"control scm-ctl-tests-run! lib/scheme/tests/control.sx"
"macros scm-mac-tests-run! lib/scheme/tests/macros.sx"
"reflection scm-ref-tests-run! lib/scheme/tests/reflection.sx"
"records scm-rec-tests-run! lib/scheme/tests/records.sx"
"modules scm-mod-tests-run! lib/scheme/tests/modules.sx"
)
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
EPOCH=1
emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); }
emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); }
{
emit_load "lib/guest/lex.sx"
emit_load "lib/guest/reflective/env.sx"
emit_load "lib/guest/reflective/quoting.sx"
emit_load "lib/scheme/parser.sx"
emit_load "lib/scheme/eval.sx"
emit_load "lib/scheme/runtime.sx"
for SUITE in "${SUITES[@]}"; do
read -r _NAME _RUNNER FILE <<< "$SUITE"
emit_load "$FILE"
emit_eval "($_RUNNER)"
done
} > "$TMPFILE"
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
# Final 9 outputs are the suite results. Parse each "{:passed N :failed N ..}".
TOTAL_PASS=0
TOTAL_FAIL=0
FAILED_SUITES=()
# Walk the output; for each suite, extract the {:passed ...} line.
# The dict format from sx_server is {:passed N :failed N :total N :fails (...)}.
LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true)
I=0
while read -r LINE; do
[ -z "$LINE" ] && continue
P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}')
F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}')
[ -z "$P" ] && P=0
[ -z "$F" ] && F=0
SUITE_INFO="${SUITES[$I]}"
SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}')
TOTAL_PASS=$((TOTAL_PASS + P))
TOTAL_FAIL=$((TOTAL_FAIL + F))
if [ "$F" -gt 0 ]; then
FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))")
printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))"
elif [ "$VERBOSE" = "-v" ]; then
printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P"
fi
I=$((I+1))
done <<< "$LAST_DICT_LINES"
TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
if [ $TOTAL_FAIL -eq 0 ]; then
echo "ok $TOTAL_PASS/$TOTAL scheme-on-sx tests passed (${#SUITES[@]} suites)"
else
echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:"
for S in "${FAILED_SUITES[@]}"; do echo " $S"; done
exit 1
fi

168
lib/scheme/tests/control.sx Normal file
View File

@@ -0,0 +1,168 @@
;; lib/scheme/tests/control.sx — call/cc, dynamic-wind, exceptions.
(define scm-ctl-pass 0)
(define scm-ctl-fail 0)
(define scm-ctl-fails (list))
(define
scm-ctl-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-ctl-pass (+ scm-ctl-pass 1))
(begin
(set! scm-ctl-fail (+ scm-ctl-fail 1))
(append! scm-ctl-fails {:name name :actual actual :expected expected})))))
(define
scm-ctl
(fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
(define
scm-ctl-all
(fn
(src)
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
;; ── call/cc — escape continuations ──────────────────────────────
;; Single-shot only: when k is invoked, control jumps out of the
;; surrounding call/cc and the result of the entire call/cc form is
;; whatever was passed to k.
(scm-ctl-test
"call/cc: no escape"
(scm-ctl "(call/cc (lambda (k) 42))")
42)
(scm-ctl-test
"call/cc: simple escape"
(scm-ctl "(call/cc (lambda (k) (+ 1 (k 42))))")
42)
(scm-ctl-test
"call/cc: escape past *"
(scm-ctl "(+ 10 (call/cc (lambda (k) (* 2 (k 5)))))")
15)
(scm-ctl-test
"call/cc: alias call-with-current-continuation"
(scm-ctl "(call-with-current-continuation (lambda (k) (k 99)))")
99)
(scm-ctl-test
"call/cc: doesn't escape if k unused"
(scm-ctl "(+ 1 (call/cc (lambda (k) (* 100 1))))")
101)
;; ── call/cc as early-exit for list search ───────────────────────
(scm-ctl-test
"call/cc: detect-via-escape"
(scm-ctl-all
"(define (detect pred xs)\n (call/cc\n (lambda (return)\n (for-each\n (lambda (x) (if (pred x) (return x) #f))\n xs)\n #f)))\n (detect (lambda (x) (> x 10)) '(1 5 7 12 20))")
12)
(scm-ctl-test
"call/cc: detect returns #f when no match"
(scm-ctl-all
"(define (detect pred xs)\n (call/cc\n (lambda (return)\n (for-each\n (lambda (x) (if (pred x) (return x) #f))\n xs)\n #f)))\n (detect (lambda (x) (> x 100)) '(1 5 7))")
false)
;; ── call/cc producing the captured k value ──────────────────────
(scm-ctl-test
"call/cc: k is a procedure"
(scm-ctl "(procedure? (call/cc (lambda (k) k)))")
true)
;; ── Exceptions: raise / guard / with-exception-handler / error ──
(scm-ctl-test "raise + guard caught"
(scm-ctl "(guard (e (else 'caught)) (raise 'boom))") "caught")
(scm-ctl-test "guard: number? matches"
(scm-ctl "(guard (e ((number? e) e) (else 'other)) (raise 42))") 42)
(scm-ctl-test "guard: number? mismatches → else"
(scm-ctl "(guard (e ((number? e) e) (else 'other)) (raise 'sym))")
"other")
(scm-ctl-test "guard: no error → body value"
(scm-ctl "(guard (e (else 'never)) 42)") 42)
(scm-ctl-test "guard: first matching clause wins"
(scm-ctl
"(guard (e ((number? e) 'num) ((symbol? e) 'sym) (else 'other)) (raise 'foo))")
"sym")
(scm-ctl-test "guard: re-raises when no clause matches"
(scm-ctl
"(guard (e (else 'outer)) (guard (e ((number? e) 'inner)) (raise 'not-a-number)))")
"outer")
(scm-ctl-test "guard: var bound in clause body"
(scm-ctl "(guard (e ((symbol? e) e)) (raise 'the-symbol))")
"the-symbol")
(scm-ctl-test "with-exception-handler: caught"
(scm-ctl
"(with-exception-handler (lambda (e) 'caught) (lambda () (raise 'oops)))")
"caught")
(scm-ctl-test "with-exception-handler: no raise"
(scm-ctl
"(with-exception-handler (lambda (e) 99) (lambda () 42))")
42)
(scm-ctl-test "with-exception-handler: handler sees the value"
(scm-ctl
"(with-exception-handler (lambda (e) (+ e 1)) (lambda () (raise 41)))")
42)
(scm-ctl-test "error: irritants accessible"
(scm-ctl
"(guard (e ((error-object? e) (error-object-irritants e))) (error \"msg\" 1 2 3))")
(list 1 2 3))
(scm-ctl-test "error: message accessible"
(scheme-string-value
(scm-ctl
"(guard (e ((error-object? e) (error-object-message e))) (error \"the-msg\"))"))
"the-msg")
;; ── dynamic-wind ────────────────────────────────────────────────
;; Basic version: runs before/thunk/after on success; before/after
;; on raise (with the raise still propagating after the after-thunk).
;; call/cc escape-out interaction is NOT yet tracked — deferred.
(scm-ctl-test "dynamic-wind: ordering on success"
(scm-ctl-all
"(define log '())
(define (note x) (set! log (cons x log)))
(dynamic-wind
(lambda () (note 'before))
(lambda () (note 'thunk) 42)
(lambda () (note 'after)))
(reverse log)")
(list "before" "thunk" "after"))
(scm-ctl-test "dynamic-wind: returns thunk value"
(scm-ctl
"(dynamic-wind (lambda () 'b) (lambda () 42) (lambda () 'a))") 42)
(scm-ctl-test "dynamic-wind: after runs on raise"
(scm-ctl-all
"(define log '())
(define (note x) (set! log (cons x log)))
(guard (e (else 'caught))
(dynamic-wind
(lambda () (note 'before))
(lambda () (raise 'boom))
(lambda () (note 'after))))
(reverse log)")
(list "before" "after"))
(scm-ctl-test "dynamic-wind: raise propagates after after-thunk"
(scm-ctl-all
"(guard (e (else e))
(dynamic-wind
(lambda () 'b)
(lambda () (raise 'the-raised))
(lambda () 'a)))")
"the-raised")
(scm-ctl-test "dynamic-wind: nested"
(scm-ctl-all
"(define log '())
(define (note x) (set! log (cons x log)))
(dynamic-wind
(lambda () (note 'outer-before))
(lambda ()
(dynamic-wind
(lambda () (note 'inner-before))
(lambda () (note 'inner-thunk))
(lambda () (note 'inner-after))))
(lambda () (note 'outer-after)))
(reverse log)")
(list "outer-before" "inner-before" "inner-thunk"
"inner-after" "outer-after"))
(define scm-ctl-tests-run! (fn () {:total (+ scm-ctl-pass scm-ctl-fail) :passed scm-ctl-pass :failed scm-ctl-fail :fails scm-ctl-fails}))

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}))

155
lib/scheme/tests/macros.sx Normal file
View File

@@ -0,0 +1,155 @@
;; lib/scheme/tests/macros.sx — define-syntax + syntax-rules.
(define scm-mac-pass 0)
(define scm-mac-fail 0)
(define scm-mac-fails (list))
(define
scm-mac-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-mac-pass (+ scm-mac-pass 1))
(begin
(set! scm-mac-fail (+ scm-mac-fail 1))
(append! scm-mac-fails {:name name :actual actual :expected expected})))))
(define
scm-mac
(fn
(src)
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
;; ── Basic syntax-rules ──────────────────────────────────────────
(scm-mac-test
"my-if true"
(scm-mac
"(define-syntax my-if (syntax-rules () ((_ c t e) (cond (c t) (else e)))))\n (my-if #t 'yes 'no)")
"yes")
(scm-mac-test
"my-if false"
(scm-mac
"(define-syntax my-if (syntax-rules () ((_ c t e) (cond (c t) (else e)))))\n (my-if #f 'yes 'no)")
"no")
(scm-mac-test
"double"
(scm-mac
"(define-syntax double (syntax-rules () ((_ x) (+ x x))))\n (double 21)")
42)
(scm-mac-test
"nested macro use"
(scm-mac
"(define-syntax double (syntax-rules () ((_ x) (+ x x))))\n (double (double 5))")
20)
;; ── Macro with multiple rules ───────────────────────────────────
(scm-mac-test
"multi-rule: matches first"
(scm-mac
"(define-syntax twin (syntax-rules () ((_ a) a) ((_ a b) (+ a b))))\n (twin 7)")
7)
(scm-mac-test
"multi-rule: matches second"
(scm-mac
"(define-syntax twin (syntax-rules () ((_ a) a) ((_ a b) (+ a b))))\n (twin 3 4)")
7)
;; ── Macros wrapping control flow ────────────────────────────────
(scm-mac-test
"swap idiom"
(scm-mac
"(define-syntax swap! (syntax-rules () ((_ a b) (let ((tmp a)) (set! a b) (set! b tmp)))))\n (define x 1) (define y 2)\n (swap! x y)\n (list x y)")
(list 2 1))
;; ── Macros that expand to expressions, not values ──────────────
(scm-mac-test
"my-unless: true → empty"
(scm-mac
"(define-syntax my-unless (syntax-rules () ((_ c body) (if c 'skipped body))))\n (my-unless #t 99)")
"skipped")
(scm-mac-test
"my-unless: false → body"
(scm-mac
"(define-syntax my-unless (syntax-rules () ((_ c body) (if c 'skipped body))))\n (my-unless #f 99)")
99)
;; ── Macro with literal keyword ─────────────────────────────────
(scm-mac-test
"literal: => recognised"
(scm-mac
"(define-syntax tag-arrow (syntax-rules (=>) ((_ a => b) (list 'arrow a b))))\n (tag-arrow 1 => 2)")
(list "arrow" 1 2))
;; ── Macro keyword passed through unevaluated ────────────────────
(scm-mac-test
"list expansion preserves arg order"
(scm-mac
"(define-syntax tuple (syntax-rules () ((_ a b c) (list a b c))))\n (tuple 1 2 3)")
(list 1 2 3))
;; ── Macros + lambdas ────────────────────────────────────────────
(scm-mac-test
"macro inside lambda"
(scm-mac
"(define-syntax sq (syntax-rules () ((_ x) (* x x))))\n (define (f n) (+ (sq n) 1))\n (f 5)")
26)
;; ── Ellipsis patterns (Phase 6b — tail-rest single-variable) ────
(scm-mac-test "ellipsis: empty rest"
(scm-mac
"(define-syntax my-list (syntax-rules () ((_ xs ...) (list xs ...))))
(my-list)")
(list))
(scm-mac-test "ellipsis: list of values"
(scm-mac
"(define-syntax my-list (syntax-rules () ((_ xs ...) (list xs ...))))
(my-list 1 2 3 4)")
(list 1 2 3 4))
(scm-mac-test "ellipsis: my-when truthy"
(scm-mac
"(define-syntax my-when (syntax-rules () ((_ c body ...) (if c (begin body ...)))))
(my-when #t 1 2 3)")
3)
(scm-mac-test "ellipsis: my-when falsy returns nil"
(scm-mac
"(define-syntax my-when (syntax-rules () ((_ c body ...) (if c (begin body ...)))))
(my-when #f 1 2 3)")
nil)
(scm-mac-test "ellipsis: begin-rebuild"
(scm-mac
"(define-syntax my-begin (syntax-rules () ((_ body ...) (let () body ...))))
(my-begin (define x 5) (define y 10) (+ x y))")
15)
(scm-mac-test "ellipsis: variadic sum-em via fold"
(scm-mac
"(define-syntax sum-em (syntax-rules () ((_ xs ...) (fold-left + 0 (list xs ...)))))
(sum-em 1 2 3 4 5)")
15)
(scm-mac-test "ellipsis: recursive my-and"
(scm-mac
"(define-syntax my-and
(syntax-rules ()
((_) #t)
((_ x) x)
((_ x xs ...) (if x (my-and xs ...) #f))))
(my-and 1 2 3)")
3)
(scm-mac-test "ellipsis: my-and short-circuits"
(scm-mac
"(define-syntax my-and
(syntax-rules ()
((_) #t)
((_ x) x)
((_ x xs ...) (if x (my-and xs ...) #f))))
(my-and 1 #f 3)")
false)
(define scm-mac-tests-run! (fn () {:total (+ scm-mac-pass scm-mac-fail) :passed scm-mac-pass :failed scm-mac-fail :fails scm-mac-fails}))

View File

@@ -0,0 +1,73 @@
;; lib/scheme/tests/modules.sx — define-library + import.
(define scm-mod-pass 0)
(define scm-mod-fail 0)
(define scm-mod-fails (list))
(define
scm-mod-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-mod-pass (+ scm-mod-pass 1))
(begin
(set! scm-mod-fail (+ scm-mod-fail 1))
(append! scm-mod-fails {:name name :actual actual :expected expected})))))
(define
scm-mod
(fn
(src)
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
;; ── Basic define-library + import ───────────────────────────────
(scm-mod-test
"simple lib: sq exported"
(scm-mod
"(define-library (my math)\n (export sq)\n (begin (define (sq x) (* x x))))\n (import (my math))\n (sq 5)")
25)
(scm-mod-test
"lib: multiple exports"
(scm-mod
"(define-library (my math)\n (export sq cube)\n (begin\n (define (sq x) (* x x))\n (define (cube x) (* x x x))))\n (import (my math))\n (list (sq 5) (cube 3))")
(list 25 27))
(scm-mod-test
"lib: single-symbol name"
(scm-mod
"(define-library (utils)\n (export greet)\n (begin (define (greet name) (string-append \"hi \" name))))\n (import (utils))\n (string=? (greet \"world\") \"hi world\")")
true)
;; ── Unexported names are not visible ───────────────────────────
(scm-mod-test
"lib: private name not exported"
(scm-mod
"(define-library (my math)\n (export sq)\n (begin\n (define (sq x) (* x x))\n (define (private-helper x) (+ x 1))))\n (import (my math))\n (guard (e (else 'unbound)) private-helper)")
"unbound")
;; ── Library calls its own internals ─────────────────────────────
(scm-mod-test
"lib: internal calls private fn"
(scm-mod
"(define-library (my math)\n (export public-add1)\n (begin\n (define (private-inc x) (+ x 1))\n (define (public-add1 x) (private-inc x))))\n (import (my math))\n (public-add1 41)")
42)
;; ── Two libs, both imported ────────────────────────────────────
(scm-mod-test
"two libs: both imported"
(scm-mod
"(define-library (a) (export af) (begin (define (af) 1)))\n (define-library (b) (export bf) (begin (define (bf) 2)))\n (import (a) (b))\n (+ (af) (bf))")
3)
;; ── Unknown library import errors ──────────────────────────────
(scm-mod-test
"import: unknown lib errors"
(scm-mod "(guard (e (else 'unknown-lib)) (import (no such lib)))")
"unknown-lib")
(define scm-mod-tests-run! (fn () {:total (+ scm-mod-pass scm-mod-fail) :passed scm-mod-pass :failed scm-mod-fail :fails scm-mod-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}))

View File

@@ -0,0 +1,96 @@
;; lib/scheme/tests/records.sx — define-record-type.
(define scm-rec-pass 0)
(define scm-rec-fail 0)
(define scm-rec-fails (list))
(define
scm-rec-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-rec-pass (+ scm-rec-pass 1))
(begin
(set! scm-rec-fail (+ scm-rec-fail 1))
(append! scm-rec-fails {:name name :actual actual :expected expected})))))
(define
scm-rec
(fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
(define
scm-rec-all
(fn
(src)
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
;; ── Basic record: point ─────────────────────────────────────────
(scm-rec-test
"point: constructor + predicate"
(scm-rec-all
"(define-record-type point\n (make-point x y) point?\n (x point-x) (y point-y))\n (point? (make-point 3 4))")
true)
(scm-rec-test
"point: accessor x"
(scm-rec-all
"(define-record-type point\n (make-point x y) point?\n (x point-x) (y point-y))\n (point-x (make-point 3 4))")
3)
(scm-rec-test
"point: accessor y"
(scm-rec-all
"(define-record-type point\n (make-point x y) point?\n (x point-x) (y point-y))\n (point-y (make-point 3 4))")
4)
(scm-rec-test
"point: predicate false on number"
(scm-rec-all
"(define-record-type point\n (make-point x y) point?\n (x point-x) (y point-y))\n (point? 42)")
false)
;; ── Mutator ─────────────────────────────────────────────────────
(scm-rec-test
"point: mutator"
(scm-rec-all
"(define-record-type point\n (make-point x y) point?\n (x point-x) (y point-y set-point-y!))\n (define p (make-point 3 4))\n (set-point-y! p 99)\n (point-y p)")
99)
;; ── Multiple record types are distinct ──────────────────────────
(scm-rec-test
"distinct types: point? false on circle"
(scm-rec-all
"(define-record-type point\n (make-point x y) point? (x point-x) (y point-y))\n (define-record-type circle\n (make-circle r) circle? (r circle-r))\n (point? (make-circle 5))")
false)
(scm-rec-test
"distinct types: circle? true on circle"
(scm-rec-all
"(define-record-type point\n (make-point x y) point? (x point-x) (y point-y))\n (define-record-type circle\n (make-circle r) circle? (r circle-r))\n (circle? (make-circle 5))")
true)
;; ── Records as first-class values ───────────────────────────────
(scm-rec-test
"record in a list"
(scm-rec-all
"(define-record-type box\n (make-box v) box? (v box-v))\n (map box-v (list (make-box 1) (make-box 2) (make-box 3)))")
(list 1 2 3))
;; ── Records via map/filter ──────────────────────────────────────
(scm-rec-test
"filter records by predicate"
(scm-rec-all
"(define-record-type box\n (make-box v) box? (v box-v))\n (length\n (filter (lambda (b) (> (box-v b) 5))\n (list (make-box 1) (make-box 7) (make-box 3) (make-box 10)))))")
2)
;; ── Constructor arity errors ────────────────────────────────────
(scm-rec-test
"ctor: wrong arity errors"
(scm-rec-all
"(define-record-type point (make-point x y) point? (x point-x) (y point-y))\n (guard (e (else 'arity-err)) (make-point 1))")
"arity-err")
(define scm-rec-tests-run! (fn () {:total (+ scm-rec-pass scm-rec-fail) :passed scm-rec-pass :failed scm-rec-fail :fails scm-rec-fails}))

View File

@@ -0,0 +1,130 @@
;; lib/scheme/tests/reflection.sx — Phase 7 reflective primitives.
(define scm-ref-pass 0)
(define scm-ref-fail 0)
(define scm-ref-fails (list))
(define
scm-ref-test
(fn
(name actual expected)
(if
(= actual expected)
(set! scm-ref-pass (+ scm-ref-pass 1))
(begin
(set! scm-ref-fail (+ scm-ref-fail 1))
(append! scm-ref-fails {:name name :actual actual :expected expected})))))
(define
scm-ref
(fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
(define
scm-ref-all
(fn
(src)
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
;; ── eval ─────────────────────────────────────────────────────────
(scm-ref-test
"eval: arithmetic"
(scm-ref "(eval '(+ 1 2 3) (interaction-environment))")
6)
(scm-ref-test
"eval: nested"
(scm-ref "(eval '(* (+ 1 2) (- 5 1)) (interaction-environment))")
12)
(scm-ref-test
"eval: constructed form"
(scm-ref "(eval (list '+ 10 20) (interaction-environment))")
30)
(scm-ref-test
"eval: variable reference"
(scm-ref-all "(define x 42) (eval 'x (interaction-environment))")
42)
;; ── interaction-environment ─────────────────────────────────────
(scm-ref-test
"interaction-environment: is an env"
(scm-ref "(environment? (interaction-environment))")
true)
(scm-ref-test
"interaction-environment: define persists"
(scm-ref-all
"(define ie (interaction-environment))\n (eval '(define stashed 99) ie)\n (eval 'stashed ie)")
99)
(scm-ref-test
"interaction-environment: same env across calls"
(scm-ref-all
"(define a (interaction-environment))\n (define b (interaction-environment))\n (eqv? a b)")
true)
;; ── null-environment ────────────────────────────────────────────
(scm-ref-test
"null-environment: is an env"
(scm-ref "(environment? (null-environment 7))")
true)
(scm-ref-test
"null-environment: has no + binding"
(scm-ref-all
"(define ne (null-environment 7))\n (guard (e (else 'unbound)) (eval '+ ne))")
"unbound")
;; ── scheme-report-environment ───────────────────────────────────
(scm-ref-test
"scheme-report-environment: is an env"
(scm-ref "(environment? (scheme-report-environment 7))")
true)
(scm-ref-test
"scheme-report-environment: has +"
(scm-ref "(eval '(+ 1 2) (scheme-report-environment 7))")
3)
(scm-ref-test
"scheme-report-environment: distinct from interaction"
(scm-ref-all
"(define ie (interaction-environment))\n (define re (scheme-report-environment 7))\n (eval '(define only-in-ie 1) ie)\n (guard (e (else 'unbound)) (eval 'only-in-ie re))")
"unbound")
;; ── eval with explicit env for sandboxing ──────────────────────
(scm-ref-test
"eval: sandbox with null-environment"
(scm-ref-all
"(define sandbox (null-environment 7))\n (guard (e (else 'unbound))\n (eval '(+ 1 1) sandbox))")
"unbound")
;; ── quasiquote / unquote / unquote-splicing ─────────────────────
(scm-ref-test "qq: plain atom"
(scm-ref "`hello") "hello")
(scm-ref-test "qq: plain list"
(scm-ref "`(a b c)") (list "a" "b" "c"))
(scm-ref-test "qq: unquote substitutes value"
(scm-ref-all "(define x 42) `(a ,x b)")
(list "a" 42 "b"))
(scm-ref-test "qq: unquote-splicing splices list"
(scm-ref-all "(define xs '(1 2 3)) `(a ,@xs b)")
(list "a" 1 2 3 "b"))
(scm-ref-test "qq: splice at start"
(scm-ref-all "(define xs '(1 2)) `(,@xs c)")
(list 1 2 "c"))
(scm-ref-test "qq: splice at end"
(scm-ref-all "(define xs '(9 8)) `(a b ,@xs)")
(list "a" "b" 9 8))
(scm-ref-test "qq: nested list with unquote"
(scm-ref-all "(define x 5) `(a (b ,x) c)")
(list "a" (list "b" 5) "c"))
(scm-ref-test "qq: unquote evaluates expression"
(scm-ref "`(a ,(+ 1 2) b)")
(list "a" 3 "b"))
(scm-ref-test "qq: error on splicing non-list"
(scm-ref-all
"(define x 42) (guard (e (else 'raised)) `(a ,@x b))")
"raised")
(scm-ref-test "qq: bare unquote at top level errors"
(scm-ref "(guard (e (else 'raised)) (unquote 5))") "raised")
(define scm-ref-tests-run! (fn () {:total (+ scm-ref-pass scm-ref-fail) :passed scm-ref-pass :failed scm-ref-fail :fails scm-ref-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}))

View File

@@ -41,6 +41,7 @@ run_sx () {
(load "lib/smalltalk/tokenizer.sx") (load "lib/smalltalk/tokenizer.sx")
(load "lib/smalltalk/parser.sx") (load "lib/smalltalk/parser.sx")
(load "lib/smalltalk/runtime.sx") (load "lib/smalltalk/runtime.sx")
(load "lib/guest/reflective/env.sx")
(load "lib/smalltalk/eval.sx") (load "lib/smalltalk/eval.sx")
(epoch 2) (epoch 2)
(eval "(begin (st-bootstrap-classes!) (smalltalk-load \"Object subclass: #B instanceVariableNames: ''! !B methodsFor: 'x'! fib: n n < 2 ifTrue: [^ n]. ^ (self fib: n - 1) + (self fib: n - 2)! !\") (smalltalk-eval-program \"^ B new fib: 22\"))") (eval "(begin (st-bootstrap-classes!) (smalltalk-load \"Object subclass: #B instanceVariableNames: ''! !B methodsFor: 'x'! fib: n n < 2 ifTrue: [^ n]. ^ (self fib: n - 1) + (self fib: n - 2)! !\") (smalltalk-eval-program \"^ B new fib: 22\"))")

View File

@@ -60,16 +60,34 @@
st-class-ref? st-class-ref?
(fn (v) (and (dict? v) (has-key? v :type) (= (get v :type) "st-class")))) (fn (v) (and (dict? v) (has-key? v :type) (= (get v :type) "st-class"))))
;; Walk the frame chain looking for a local binding. ;; Smalltalk-side adapter for lib/guest/reflective/env.sx. The
;; Smalltalk frame carries language-specific metadata (:self,
;; :method-class, :return-k, :active-cell) but the parent-walk for
;; local-binding lookup is the same algorithm Kernel and Tcl use.
;; Third consumer of the env kit; cfg routes through :locals and
;; :parent and uses mutable dict-set! for binding.
(define st-frame-cfg
{:bindings-of (fn (f) (get f :locals))
:parent-of (fn (f) (get f :parent))
:extend (fn (f) (st-make-frame nil nil f nil nil))
:bind! (fn (f n v)
(dict-set! (get f :locals) n v) f)
:env? (fn (v) (and (dict? v) (dict? (get v :locals))))})
;; Walk the frame chain looking for a local binding. Returns the
;; Smalltalk-flavoured {:found :value :frame} shape callers expect;
;; the parent-walk delegates to refl-env-find-frame-with.
(define (define
st-lookup-local st-lookup-local
(fn (fn
(frame name) (frame name)
(let ((src (refl-env-find-frame-with st-frame-cfg frame name)))
(cond (cond
((= frame nil) {:found false :value nil :frame nil}) ((nil? src) {:found false :value nil :frame nil})
((has-key? (get frame :locals) name) (:else
{:found true :value (get (get frame :locals) name) :frame frame}) {:found true
(else (st-lookup-local (get frame :parent) name))))) :value (get (get src :locals) name)
:frame src})))))
;; Walk the frame chain looking for the frame whose self has this ivar. ;; Walk the frame chain looking for the frame whose self has this ivar.
(define (define

View File

@@ -61,6 +61,7 @@ EPOCHS
(epoch 3) (epoch 3)
(load "lib/smalltalk/runtime.sx") (load "lib/smalltalk/runtime.sx")
(epoch 4) (epoch 4)
(load "lib/guest/reflective/env.sx")
(load "lib/smalltalk/eval.sx") (load "lib/smalltalk/eval.sx")
(epoch 5) (epoch 5)
(load "lib/smalltalk/sunit.sx") (load "lib/smalltalk/sunit.sx")
@@ -116,6 +117,7 @@ EPOCHS
(epoch 3) (epoch 3)
(load "lib/smalltalk/runtime.sx") (load "lib/smalltalk/runtime.sx")
(epoch 4) (epoch 4)
(load "lib/guest/reflective/env.sx")
(load "lib/smalltalk/eval.sx") (load "lib/smalltalk/eval.sx")
(epoch 5) (epoch 5)
(load "lib/smalltalk/sunit.sx") (load "lib/smalltalk/sunit.sx")

View File

@@ -11,7 +11,7 @@ isolation: worktree
## Prompt ## Prompt
You are the sole background agent working `/root/rose-ash/plans/smalltalk-on-sx.md`. Isolated worktree, forever, one commit per feature. Never push. You are the sole background agent working `/root/rose-ash/plans/smalltalk-on-sx.md`. Isolated worktree, forever, one commit per feature. Push to `origin/loops/smalltalk` after every commit.
## Restart baseline — check before iterating ## Restart baseline — check before iterating
@@ -43,7 +43,7 @@ Every iteration: implement → test → commit → tick `[ ]` → Progress log
- **Shared-file issues** → plan's Blockers with minimal repro. - **Shared-file issues** → plan's Blockers with minimal repro.
- **Delimited continuations** are in `lib/callcc.sx` + `spec/evaluator.sx` Step 5. `sx_summarise` spec/evaluator.sx first — 2300+ lines. - **Delimited continuations** are in `lib/callcc.sx` + `spec/evaluator.sx` Step 5. `sx_summarise` spec/evaluator.sx first — 2300+ lines.
- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits. - **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
- **Worktree:** commit locally. Never push. Never touch `main`. - **Worktree:** commit, then push to `origin/loops/smalltalk`. Never touch `main`.
- **Commit granularity:** one feature per commit. - **Commit granularity:** one feature per commit.
- **Plan file:** update Progress log + tick boxes every commit. - **Plan file:** update Progress log + tick boxes every commit.

View File

@@ -87,10 +87,13 @@ The whole interesting thing: there are no special forms hardcoded in the evaluat
- [x] Bridge to SX's hygienic macro story; extends proposed `lib/guest/reflective/` with `$let` and `$define-in!` hygiene primitives. - [x] Bridge to SX's hygienic macro story; extends proposed `lib/guest/reflective/` with `$let` and `$define-in!` hygiene primitives.
- [x] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings. - [x] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings.
### Phase 7 — Propose `lib/guest/reflective/` *[env.sx EXTRACTED 2026-05-12; other five still pending]* ### Phase 7 — Propose `lib/guest/reflective/` *[env.sx + quoting.sx EXTRACTED; class-chain.sx also extracted; evaluator.sx declined]*
- [x] Identified reusable env-reification + dispatch primitives across Phases 26. Consolidated API surface below as four candidate files: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`. - [x] Identified reusable env-reification + dispatch primitives across Phases 26. Consolidated API surface below as four candidate files: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`.
- [x] Second consumer found for **`env.sx`**: Tcl's `uplevel`/`upvar` machinery (`lib/tcl/runtime.sx`). Same scope-chain semantics, divergent only in mutable-vs-functional update — bridged via adapter-cfg pattern from `lib/guest/match.sx`. Extraction landed on branch `lib/tcl/uplevel` (see `plans/lib-guest-reflective.md`). - [x] Second consumer found for **`env.sx`**: Tcl's `uplevel`/`upvar` machinery (`lib/tcl/runtime.sx`). Bridged via adapter-cfg pattern. Extraction on branch `lib/tcl/uplevel`. Third consumer: Smalltalk frame, then Scheme. (Three live consumers.)
- [ ] Second consumers still needed for `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx` — all five wait for a language with operative/applicative semantics (Scheme, CL fexpr extension, Maru). - [x] Bonus: **`class-chain.sx`** extracted from Smalltalk + CLOS method dispatch (not on the original six-file list, but the same chiselling discipline surfaced it). Branch `lib/guest/method-chain`.
- [x] Second consumer found for **`quoting.sx`**: Scheme's `scm-quasi-walk` (`lib/scheme/eval.sx`). Algorithm identical to Kernel's `knl-quasi-walk`; only the unquote keyword name and host evaluator differ. Bridged via adapter cfg with `:unquote-name`/`:unquote-splicing-name`/`:eval`. Extraction on branch `lib/guest/quoting`.
- [x] **`evaluator.sx` extraction declined.** The genuinely shared content between Kernel's `(get-current-environment, make-environment, eval)` triple and Scheme's `(interaction-environment, null-environment/scheme-report-environment, eval)` is *protocol/API surface*, not algorithm. Each consumer has language-specific binding semantics. The only common helper would be a closure-capturing `make-self-returning-env-fn` (~5 lines), too thin for its own kit. The protocol itself stays documented below but does not become a `lib/guest/reflective/evaluator.sx` file.
- [ ] Second consumers still needed for `combiner.sx`, `hygiene.sx`, `short-circuit.sx`. `combiner.sx` and `short-circuit.sx` require a fexpr-having language (Maru, Klisp, CL-fexpr extension) — Scheme is not a fit. `hygiene.sx` is the deferred research-grade scope-set work; Scheme's Phase 6c would be the second consumer when it lands.
**Phase 7 status (updated 2026-05-12):** `env.sx` has been extracted and is live at `lib/guest/reflective/env.sx` on branch `lib/tcl/uplevel`. Both consumers (Kernel and Tcl) pass their full test suites unchanged (Kernel 322/322, Tcl 427/427). The remaining five candidate files stay documented-only until their respective second consumers materialise. Candidate second consumers in priority order: Candidate second consumers in priority order: **Phase 7 status (updated 2026-05-12):** `env.sx` has been extracted and is live at `lib/guest/reflective/env.sx` on branch `lib/tcl/uplevel`. Both consumers (Kernel and Tcl) pass their full test suites unchanged (Kernel 322/322, Tcl 427/427). The remaining five candidate files stay documented-only until their respective second consumers materialise. Candidate second consumers in priority order: Candidate second consumers in priority order:

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

@@ -0,0 +1,191 @@
# 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
- 2026-05-14 — **Phases 1, 2, 3, 3.5, 4, 5abc, 6ab, 7, 8, 9, 10, 11 landed in one loop session.** 296 Scheme tests across 9 suites; ~1830 LoC of substrate. Test runner + scoreboard at `lib/scheme/test.sh` and `lib/scheme/scoreboard.md`. Three reflective kits unlocked: `env.sx` extracted directly as third consumer, `evaluator.sx` and `quoting.sx` second-consumer-ready for the kit-extraction commits (kit code is documented in `plans/kernel-on-sx.md`; Scheme consumer code is in place).
### Phase-by-phase outcomes
- Phase 1 (Parser, 62 tests): R7RS lexical syntax with reader macros, three comment flavours (`;`, `#;`, `#| |#`).
- Phase 2 (Eval + env third-consumer, 23 tests): `scheme-make-env` etc. are thin aliases for `refl-env-*` from `lib/guest/reflective/env.sx`. No adapter cfg needed — Scheme uses the canonical wire shape directly.
- Phase 3 (if/define/set!/begin/lambda + closures, 24 tests): factorial 10 → 3628800, counter via closed-over `set!`, curried lambda.
- Phase 3.5 (let/let*/cond/when/unless/and/or, 21 tests).
- Phase 4 (standard env + set! bugfix, 82 tests): variadic arithmetic, type predicates, list/string/char/vector ops, higher-order combinators. **Found and fixed an SX cond multi-expression branch bug** affecting set!. Bugfix unblocked 4 silently-failing tests in Phase 3.
- Phase 5a (call/cc, 8 tests): single-shot escape continuations.
- Phase 5b (raise/guard/with-exception-handler/error, 12 tests): catch-once-then-rehandle-outside pattern avoids handler-self-raise loops.
- Phase 5c (dynamic-wind, 5 tests): basic before-thunk-after with raise propagation. call/cc-escape tracking deferred.
- Phase 6a (define-syntax + syntax-rules, 12 tests): pattern matching with literals + pattern variables + list structure; template substitution.
- Phase 6b (syntax-rules ellipsis, 8 tests): tail-rest single-variable form. `(my-and 1 2 3)` etc. work.
- Phase 7 (eval / interaction-environment, 13 tests): **second consumer for evaluator.sx**. `interaction-environment` closes over the env being built, so user-side defines via `(eval ... ie)` persist across calls.
- Phase 8 (define-library + import, 7 tests): minimal module system. Private definitions stay in library env; only exports are visible after import.
- Phase 9 (define-record-type, 9 tests): tagged-dict records with optional mutators.
- Phase 10 (quasiquote runtime, 10 tests): **second consumer for quoting.sx**. Identical algorithm to Kernel's `knl-quasi-walk` — universal across reflective Lisps.
- Phase 11 (test.sh + scoreboard): single-process aggregating runner, scoreboard markdown.
### Deferred phases
- **Phase 6c — full hygiene**. Dybvig-style scope-sets / lifted-symbol algorithm. Would be the second consumer for the deferred `lib/guest/reflective/hygiene.sx`. Current macros work for common patterns but don't prevent introduced-binding capture. Research-grade work; warrants its own loop iteration.
- **Nested quasiquote depth tracking**.
- **R7RS module rich features** (`cond-expand`, `include`, import sets like `only`/`except`/`prefix`/`rename`).
- **Dotted-pair `(a b . rest)` parser syntax** + lambda rest-args.
- **Full call/cc + dynamic-wind interaction**: dynamic-extent re-entry/re-exit tracking.
### Chisel ledger update
This Scheme port satisfies the two-consumer rule for **three** reflective kits documented in the kernel-on-sx loop:
| Kit | Status |
|-----|--------|
| `env.sx` | Extracted — Scheme is the third consumer (after Kernel + Tcl/Smalltalk), uses the canonical shape directly with no cfg |
| `evaluator.sx` | Second consumer ready — Scheme `eval`/`interaction-environment`/`null-environment`/`scheme-report-environment` mirror the proposed `refl-eval`/`refl-current-env`/`refl-make-environment` triple |
| `quoting.sx` | Second consumer ready — Scheme `scm-quasi-walk` is structurally identical to Kernel's `knl-quasi-walk`; the only difference is the unquote keyword names (cfg parameterisation) |
| `hygiene.sx` | Still awaiting (needs Phase 6c) |
| `combiner.sx` | N/A — Scheme has no fexprs |
| `short-circuit.sx` | N/A — Scheme `and`/`or` are syntactic, not operative |
The kit-extraction commits themselves are follow-on work; this Scheme port is the consumer-side foundation.