Compare commits

...

29 Commits

Author SHA1 Message Date
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
c27db9b78f reflective: Phase 3 docs — mark env.sx extraction DONE, others still blocked
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
plans/kernel-on-sx.md — Phase 7 header updated from "partial" to
"env.sx EXTRACTED 2026-05-12"; second-consumer-found checkbox ticked
for env.sx specifically. Other five files (combiner, evaluator,
hygiene, quoting, short-circuit) stay blocked pending their own
second consumers.

plans/lib-guest-reflective.md — Phases 1-3 ticked off with date
stamps; Outcome section added summarising the three commits, file
stats (124 LoC, within 80-200 bound), and the third-consumer
adoption protocol (cfg with five keys, no changes to env.sx).
2026-05-12 07:04:17 +00:00
39381fda92 reflective: Tcl adapter cfg — second consumer wired, 427+322 tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Phase 2 of the lib-guest-reflective extraction.

lib/tcl/runtime.sx — frame-lookup and frame-set-top now delegate to
refl-env-lookup-or-nil-with and refl-env-bind!-with via a new
tcl-frame-cfg adapter. Tcl keeps its existing {:level :locals :parent}
frame shape unchanged; the cfg bridges it to the kit's generic
algorithms. Functional update semantics preserved (cfg's :bind!
returns the new frame via assoc).

lib/tcl/test.sh + conformance.sh — load lib/guest/reflective/env.sx
before lib/tcl/runtime.sx.

Both consumers' full test suites unchanged:
- Tcl: 427/427 (parse 67, eval 169, error 39, namespace 22, coro 20,
       idiom 110)
- Kernel: 322/322 across 7 suites

The extraction is now real: two consumers, two genuinely different
wire shapes (mutable canonical vs functional frame), sharing the
parent-walk algorithm via cfg adapter — same pattern as
lib/guest/match.sx.
2026-05-12 07:02:56 +00:00
2e7e3141d4 reflective: extract env.sx + migrate Kernel — 322 tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Phase 1 of the lib-guest-reflective extraction plan.

lib/guest/reflective/env.sx — canonical wire shape
{:refl-tag :env :bindings DICT :parent ENV-OR-NIL} with mutable
defaults (dict-set!), plus *-with adapter-cfg variants for consumers
with their own shape (modelled after lib/guest/match.sx). 13 forms,
~5 KB.

lib/kernel/eval.sx — env block collapses from ~30 lines to 6 thin
wrappers (kernel-env? = refl-env?, etc.). No semantic change; envs
now carry :refl-tag :env instead of :knl-tag :env. All 322 Kernel
tests pass unchanged across 7 suites (parse 62, eval 36, vau 38,
standard 127, encap 19, hygiene 26, metacircular 14).

Next: Phase 2 — Tcl adapter cfg in lib/tcl/runtime.sx using
refl-env-lookup-with against the existing :level/:locals/:parent
frame shape.
2026-05-12 06:59:07 +00:00
edfc37636f merge: loops/kernel into lib/tcl/uplevel — bring in first consumer for extraction 2026-05-12 06:55:00 +00:00
24d8e362d5 plans: lib-guest-reflective extraction kicked off — Tcl uplevel as second consumer
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
The kernel-on-sx loop documented six candidate reflective API files
gated on the two-consumer rule. This plan opens that block by
selecting Tcl's existing uplevel/upvar machinery as the second
consumer for env.sx specifically (the highest-fit candidate).

Discovery: Kernel and Tcl have identical scope-chain semantics but
diverge on mutable-vs-functional update. Solution: adapter-cfg
pattern, same as lib/guest/match.sx. Canonical wire shape with
mutable defaults for Kernel; Tcl provides its own cfg keeping
the functional model.

Roadmap: env.sx extracted, both consumers migrated, all tests green.
The other five candidate files (combiner, evaluator, hygiene,
quoting, short-circuit) stay deferred — Tcl has no operatives.
2026-05-11 22:12:26 +00:00
0fbfce949b merge: hs-f into architecture — JIT Phase 1 (tiered compilation)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
# Conflicts:
#	hosts/ocaml/lib/sx_primitives.ml
2026-05-10 18:57:29 +00:00
ef0a24f0db plans: minikanren-deferred — four pieces of follow-up work
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Captures the work left on the shelf after the loops/minikanren squash
merge:

  Piece A — Phase 7 SLG (cyclic patho, mutual recursion). The hardest
            piece; the brief's "research-grade complexity" caveat
            still stands. Plan documents the in-progress sentinel +
            answer-accumulator + fixed-point-driver design.

  Piece B — Phase 6 polish: bounds-consistency for fd-plus / fd-times
            in the (var var var) case. Math is straightforward
            interval reasoning; low risk, self-contained.

  Piece C — =/= disequality with a constraint store. Generalises
            nafc / fd-neq to logic terms via a pending-disequality
            list re-checked after each ==.

  Piece D — Bigger CLP(FD) demos: send-more-money and Sudoku 4x4.
            Both validate Piece B once it lands.

Suggested ordering: B (low risk, unlocks D) → D (concrete validation)
→ C (independent track) → A (highest risk, do last).

Operating ground rules carried over from the original loop brief:
loops/minikanren branch, sx-tree MCP only, one feature per commit,
test count must monotonically grow.
2026-05-09 13:03:05 +00:00
30a7dd2108 JIT: mark Phase 1 done in architecture plan; document WASM ABI rollout caveat
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 47s
2026-05-08 23:57:53 +00:00
b9d63112e6 JIT: Phase 1 — tiered compilation (call-count threshold)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
OCaml kernel changes:

  sx_types.ml:
    - Add l_call_count : int field to lambda type — counts how many times
      a named lambda has been invoked through the VM dispatch path.
    - Add module-level refs jit_threshold (default 4), jit_compiled_count,
      jit_skipped_count, jit_threshold_skipped_count for stats.
      Refs live here (not sx_vm) so sx_primitives can read them without
      creating a sx_primitives → sx_vm dependency cycle.

  sx_vm.ml:
    - In the Lambda case of cek_call_or_suspend, before triggering the JIT,
      increment l.l_call_count. Only call jit_compile_ref if count >= the
      runtime-tunable threshold. Below threshold, fall through to the
      existing cek_call_or_suspend path (interpreter-style).

  sx_primitives.ml:
    - Register jit-stats — returns dict {threshold, compiled, compile-failed,
      below-threshold}.
    - Register jit-set-threshold! N — change threshold at runtime.
    - Register jit-reset-counters! — zero the stats counters.

  bin/run_tests.ml:
    - Add l_call_count = 0 to the test-fixture lambda construction.

Effect: lambdas only get JIT-compiled after the 4th invocation. One-shot
lambdas (test harness wrappers, eval-hs throwaways, REPL inputs) never enter
the JIT cache, eliminating the cumulative slowdown that the batched runner
currently works around. Hot paths (component renders, event handlers) cross
the threshold within a handful of calls and get the full JIT speed.

Phase 2 (LRU eviction) and Phase 3 (jit-reset! / jit-clear-cold!) follow.

Verified: 4771 passed, 1111 failed in OCaml run_tests.exe — identical to
baseline before this change. No regressions; tiered logic is correct.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-08 23:54:56 +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
32 changed files with 4177 additions and 77 deletions

View File

@@ -1279,7 +1279,7 @@ let run_foundation_tests () =
assert_true "sx_truthy \"\"" (Bool (sx_truthy (String "")));
assert_eq "not truthy nil" (Bool false) (Bool (sx_truthy Nil));
assert_eq "not truthy false" (Bool false) (Bool (sx_truthy (Bool false)));
let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None } in
let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None; l_call_count = 0 } in
assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l)));
ignore (Sx_types.set_lambda_name (Lambda l) "my-fn");
assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l))

View File

@@ -4109,4 +4109,25 @@ let () =
| k :: v :: rest -> ignore (env_bind child (value_to_string k) v); add_bindings rest
| [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
add_bindings pairs;
Env child)
Env child);
(* JIT cache control & observability — backed by refs in sx_types.ml to
avoid creating a sx_primitives → sx_vm dependency cycle. sx_vm reads
these refs to decide when to JIT. *)
register "jit-stats" (fun _args ->
let d = Hashtbl.create 8 in
Hashtbl.replace d "threshold" (Number (float_of_int !Sx_types.jit_threshold));
Hashtbl.replace d "compiled" (Number (float_of_int !Sx_types.jit_compiled_count));
Hashtbl.replace d "compile-failed" (Number (float_of_int !Sx_types.jit_skipped_count));
Hashtbl.replace d "below-threshold" (Number (float_of_int !Sx_types.jit_threshold_skipped_count));
Dict d);
register "jit-set-threshold!" (fun args ->
match args with
| [Number n] -> Sx_types.jit_threshold := int_of_float n; Nil
| [Integer n] -> Sx_types.jit_threshold := n; Nil
| _ -> raise (Eval_error "jit-set-threshold!: (n) where n is integer"));
register "jit-reset-counters!" (fun _args ->
Sx_types.jit_compiled_count := 0;
Sx_types.jit_skipped_count := 0;
Sx_types.jit_threshold_skipped_count := 0;
Nil)

View File

@@ -138,6 +138,7 @@ and lambda = {
l_closure : env;
mutable l_name : string option;
mutable l_compiled : vm_closure option; (** Lazy JIT cache *)
mutable l_call_count : int; (** Tiered-compilation counter — JIT after threshold calls *)
}
and component = {
@@ -449,7 +450,20 @@ let make_lambda params body closure =
| List items -> List.map value_to_string items
| _ -> value_to_string_list params
in
Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None }
Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None; l_call_count = 0 }
(** {1 JIT cache control}
Tiered compilation: only JIT a lambda after it's been called [jit_threshold]
times. This filters out one-shot lambdas (test harness, dynamic eval, REPLs)
so they never enter the JIT cache. Counters are exposed to SX as [(jit-stats)].
These live here (in sx_types) rather than sx_vm so [sx_primitives] can read
them without creating a sx_primitives → sx_vm dependency cycle. *)
let jit_threshold = ref 4
let jit_compiled_count = ref 0
let jit_skipped_count = ref 0
let jit_threshold_skipped_count = ref 0
let make_component name params has_children body closure affinity =
let n = value_to_string name in

View File

@@ -57,6 +57,9 @@ let () = Sx_types._convert_vm_suspension := (fun exn ->
let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
ref (fun _ _ -> None)
(* JIT threshold and counters live in Sx_types so primitives can read them
without creating a sx_primitives → sx_vm dependency cycle. *)
(** Sentinel closure indicating JIT compilation was attempted and failed.
Prevents retrying compilation on every call. *)
let jit_failed_sentinel = {
@@ -364,13 +367,21 @@ and vm_call vm f args =
| None ->
if l.l_name <> None
then begin
l.l_compiled <- Some jit_failed_sentinel;
match !jit_compile_ref l vm.globals with
| Some cl ->
l.l_compiled <- Some cl;
push_closure_frame vm cl args
| None ->
l.l_call_count <- l.l_call_count + 1;
if l.l_call_count >= !Sx_types.jit_threshold then begin
l.l_compiled <- Some jit_failed_sentinel;
match !jit_compile_ref l vm.globals with
| Some cl ->
incr Sx_types.jit_compiled_count;
l.l_compiled <- Some cl;
push_closure_frame vm cl args
| None ->
incr Sx_types.jit_skipped_count;
push vm (cek_call_or_suspend vm f (List args))
end else begin
incr Sx_types.jit_threshold_skipped_count;
push vm (cek_call_or_suspend vm f (List args))
end
end
else
push vm (cek_call_or_suspend vm f (List args)))

159
lib/guest/reflective/env.sx Normal file
View File

@@ -0,0 +1,159 @@
;; lib/guest/reflective/env.sx — first-class environment kit.
;;
;; Extracted from Kernel-on-SX (lib/kernel/eval.sx) when Tcl's
;; uplevel/upvar machinery (lib/tcl/runtime.sx) materialised as a
;; second consumer needing the same scope-chain semantics.
;;
;; Canonical wire shape
;; --------------------
;; {:refl-tag :env :bindings DICT :parent ENV-OR-NIL}
;;
;; - :bindings is a mutable SX dict keyed by symbol name.
;; - :parent is either another env or nil (root).
;; - Lookup walks the parent chain until a hit or nil.
;; - Default cfg uses dict-set! to mutate bindings in place.
;;
;; Consumers with their own shape (e.g., Tcl's {:level :locals :parent})
;; pass an adapter cfg dict — same trick as lib/guest/match.sx's cfg
;; for unification over guest-specific term shapes.
;;
;; Adapter cfg keys
;; ----------------
;; :bindings-of — fn (scope) → DICT
;; :parent-of — fn (scope) → SCOPE-OR-NIL
;; :extend — fn (scope) → SCOPE (push a fresh child)
;; :bind! — fn (scope name val) → scope (functional or mutable)
;; :env? — fn (v) → bool (predicate; cheap shape check)
;;
;; Public API — canonical shape, mutable, raises on miss
;;
;; (refl-make-env)
;; (refl-extend-env PARENT)
;; (refl-env? V)
;; (refl-env-bind! ENV NAME VAL)
;; (refl-env-has? ENV NAME)
;; (refl-env-lookup ENV NAME)
;; (refl-env-lookup-or-nil ENV NAME)
;;
;; Public API — adapter-cfg, any shape
;;
;; (refl-env-extend-with CFG SCOPE)
;; (refl-env-bind!-with CFG SCOPE NAME VAL)
;; (refl-env-has?-with CFG SCOPE NAME)
;; (refl-env-lookup-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
;; can compare or extend it.
;; ── Canonical-shape predicates and constructors ─────────────────
(define refl-env? (fn (v) (and (dict? v) (= (get v :refl-tag) :env))))
(define refl-make-env (fn () {:parent nil :refl-tag :env :bindings {}}))
(define refl-extend-env (fn (parent) {:parent parent :refl-tag :env :bindings {}}))
(define
refl-env-bind!
(fn (env name val) (dict-set! (get env :bindings) name val) env))
(define
refl-env-has?
(fn
(env name)
(cond
((nil? env) false)
((not (refl-env? env)) false)
((dict-has? (get env :bindings) name) true)
(:else (refl-env-has? (get env :parent) name)))))
(define
refl-env-lookup
(fn
(env name)
(cond
((nil? env) (error (str "refl-env-lookup: unbound symbol: " name)))
((not (refl-env? env))
(error (str "refl-env-lookup: corrupt env: " env)))
((dict-has? (get env :bindings) name) (get (get env :bindings) name))
(:else (refl-env-lookup (get env :parent) name)))))
(define
refl-env-lookup-or-nil
(fn
(env name)
(cond
((nil? env) nil)
((not (refl-env? env)) nil)
((dict-has? (get env :bindings) name) (get (get env :bindings) name))
(:else (refl-env-lookup-or-nil (get env :parent) name)))))
;; ── Adapter-cfg variants — any wire shape ───────────────────────
(define refl-env-extend-with (fn (cfg scope) ((get cfg :extend) scope)))
(define
refl-env-bind!-with
(fn (cfg scope name val) ((get cfg :bind!) scope name val)))
(define
refl-env-has?-with
(fn
(cfg scope name)
(cond
((nil? scope) false)
((not ((get cfg :env?) scope)) false)
((dict-has? ((get cfg :bindings-of) scope) name) true)
(:else (refl-env-has?-with cfg ((get cfg :parent-of) scope) name)))))
(define
refl-env-lookup-with
(fn
(cfg scope name)
(cond
((nil? scope) (error (str "refl-env-lookup: unbound symbol: " name)))
((not ((get cfg :env?) scope))
(error (str "refl-env-lookup: corrupt scope: " scope)))
((dict-has? ((get cfg :bindings-of) scope) name)
(get ((get cfg :bindings-of) scope) name))
(:else (refl-env-lookup-with cfg ((get cfg :parent-of) scope) name)))))
(define
refl-env-lookup-or-nil-with
(fn
(cfg scope name)
(cond
((nil? scope) nil)
((not ((get cfg :env?) scope)) nil)
((dict-has? ((get cfg :bindings-of) scope) name)
(get ((get cfg :bindings-of) scope) name))
(:else
(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 ───────────────────────────────────────
;; Exposed so consumers can use it explicitly, compose with it, or
;; check adapter-correctness against the canonical implementation.
(define refl-canonical-cfg {:bind! (fn (e n v) (refl-env-bind! e n v)) :parent-of (fn (e) (get e :parent)) :env? (fn (v) (refl-env? v)) :bindings-of (fn (e) (get e :bindings)) :extend (fn (e) (refl-extend-env e))})

View File

@@ -7,9 +7,11 @@
;;
;; Tagged values
;; -------------
;; {:knl-tag :env :bindings DICT :parent PARENT-OR-NIL}
;; {:refl-tag :env :bindings DICT :parent PARENT-OR-NIL}
;; A first-class Kernel environment. Bindings is a mutable SX dict
;; keyed by symbol name; parent walks up the lookup chain.
;; keyed by symbol name; parent walks up the lookup chain. Shape
;; and operations are inherited from lib/guest/reflective/env.sx
;; (canonical wire shape) — Kernel-side names are thin wrappers.
;;
;; {:knl-tag :operative :impl FN}
;; Primitive operative. FN receives (args dyn-env) — args are the
@@ -42,38 +44,16 @@
;;
;; Consumes: lib/kernel/parser.sx (kernel-string?, kernel-string-value)
;; ── Environments — first-class, pure-SX (binding dict + parent) ──
;; ── Environments — delegated to lib/guest/reflective/env.sx ──────
;; The env values themselves now carry `:refl-tag :env` (shared with the
;; reflective kit). Kernel's API names stay; bodies are thin wrappers.
(define kernel-env? (fn (v) (and (dict? v) (= (get v :knl-tag) :env))))
(define kernel-make-env (fn () {:parent nil :knl-tag :env :bindings {}}))
(define kernel-extend-env (fn (parent) {:parent parent :knl-tag :env :bindings {}}))
(define
kernel-env-bind!
(fn (env name val) (dict-set! (get env :bindings) name val) val))
(define
kernel-env-has?
(fn
(env name)
(cond
((nil? env) false)
((not (kernel-env? env)) false)
((dict-has? (get env :bindings) name) true)
(:else (kernel-env-has? (get env :parent) name)))))
(define
kernel-env-lookup
(fn
(env name)
(cond
((nil? env) (error (str "kernel-eval: unbound symbol: " name)))
((not (kernel-env? env))
(error (str "kernel-eval: corrupt env: " env)))
((dict-has? (get env :bindings) name) (get (get env :bindings) name))
(:else (kernel-env-lookup (get env :parent) name)))))
(define kernel-env? refl-env?)
(define kernel-make-env refl-make-env)
(define kernel-extend-env refl-extend-env)
(define kernel-env-bind! refl-env-bind!)
(define kernel-env-has? refl-env-has?)
(define kernel-env-lookup refl-env-lookup)
;; ── Tagged-value constructors and predicates ─────────────────────

1037
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.

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

@@ -0,0 +1,92 @@
#!/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/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/parser.sx")
(load "lib/smalltalk/runtime.sx")
(load "lib/guest/reflective/env.sx")
(load "lib/smalltalk/eval.sx")
(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\"))")

View File

@@ -60,16 +60,34 @@
st-class-ref?
(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
st-lookup-local
(fn
(frame name)
(cond
((= frame nil) {:found false :value nil :frame nil})
((has-key? (get frame :locals) name)
{:found true :value (get (get frame :locals) name) :frame frame})
(else (st-lookup-local (get frame :parent) name)))))
(let ((src (refl-env-find-frame-with st-frame-cfg frame name)))
(cond
((nil? src) {:found false :value nil :frame nil})
(:else
{:found true
:value (get (get src :locals) name)
:frame src})))))
;; Walk the frame chain looking for the frame whose self has this ivar.
(define

View File

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

View File

@@ -69,6 +69,7 @@ for tcl_file in "${TCL_FILES[@]}"; do
(epoch 2)
(load "lib/tcl/parser.sx")
(epoch 3)
(load "lib/guest/reflective/env.sx")
(load "lib/tcl/runtime.sx")
(epoch 4)
(load "$helper")

View File

@@ -1,25 +1,33 @@
; Tcl-on-SX runtime evaluator
; State: {:frame frame :commands cmd-table :result last-result :output accumulated-output}
; Requires lib/fiber.sx to be loaded first (provides make-fiber, fiber-resume, fiber-done?)
; Requires lib/fiber.sx and lib/guest/reflective/env.sx to be loaded first.
;
; Frames keep their Tcl-specific shape ({:level :locals :parent}) but
; route lookup/bind through the shared reflective env kit via the
; adapter cfg below — second consumer for that kit alongside Kernel.
(define make-frame (fn (level parent) {:level level :locals {} :parent parent}))
(define
frame-lookup
(fn
(frame name)
(if
(nil? frame)
nil
(let
((val (get (get frame :locals) name)))
(if (nil? val) (frame-lookup (get frame :parent) name) val)))))
; Tcl-side adapter for lib/guest/reflective/env.sx. Frames are
; functionally updated (assoc returns a fresh dict), and lookup-miss
; returns nil (Tcl convention) — the *-with kit honours both.
(define tcl-frame-cfg
{:bindings-of (fn (f) (get f :locals))
:parent-of (fn (f) (get f :parent))
:extend (fn (f) (make-frame (+ (get f :level) 1) f))
:bind! (fn (f n v) (assoc f :locals (assoc (get f :locals) n v)))
:env? (fn (v)
(and (dict? v)
(number? (get v :level))
(dict? (get v :locals))))})
(define
frame-set-top
(fn
(frame name val)
(assoc frame :locals (assoc (get frame :locals) name val))))
(define frame-lookup
(fn (frame name)
(refl-env-lookup-or-nil-with tcl-frame-cfg frame name)))
(define frame-set-top
(fn (frame name val)
(refl-env-bind!-with tcl-frame-cfg frame name val)))
(define make-tcl-interp (fn () {:result "" :output "" :code 0 :errorinfo "" :errorcode "" :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {} :current-ns "::" :coro-yield-fn nil}))

View File

@@ -42,6 +42,7 @@ cat > "$TMPFILE" << EPOCHS
(load "lib/tcl/tests/parse.sx")
(epoch 4)
(load "lib/fiber.sx")
(load "lib/guest/reflective/env.sx")
(load "lib/tcl/runtime.sx")
(epoch 5)
(load "lib/tcl/tests/eval.sx")

View File

@@ -11,7 +11,7 @@ isolation: worktree
## 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
@@ -43,7 +43,7 @@ Every iteration: implement → test → commit → tick `[ ]` → Progress log
- **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.
- **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.
- **Plan file:** update Progress log + tick boxes every commit.

View File

@@ -164,13 +164,22 @@ gets the same API for free.
## Rollout
**Phase 1: Tiered compilation (1-2 days)**
- Add `l_call_count` to lambda type
- Wire counter increment in `cek_call_or_suspend`
- Add `jit-set-threshold!` primitive
- Default threshold = 1 (no change in behavior)
- Bump default to 4 once test suite confirms stability
- Verify: HS conformance full-suite run completes without JIT saturation
**Phase 1: Tiered compilation — IMPLEMENTED (commit b9d63112)**
- `l_call_count : int` field on lambda type (sx_types.ml)
- ✅ Counter increment + threshold check in cek_call_or_suspend Lambda case (sx_vm.ml)
- ✅ Module-level refs in sx_types: `jit_threshold` (default 4), `jit_compiled_count`,
`jit_skipped_count`, `jit_threshold_skipped_count`. Refs live in sx_types so
sx_primitives can read them without creating an import cycle.
- ✅ Primitives: `jit-stats`, `jit-set-threshold!`, `jit-reset-counters!` (sx_primitives.ml)
- Verified: 4771/1111 OCaml run_tests, identical to baseline — no regressions.
**WASM rollout note:** The native binary has Phase 1 active. The browser
WASM (`shared/static/wasm/sx_browser.bc.js`) needs to be rebuilt, but the
new build uses a different value-wrapping ABI ({_type, __sx_handle} for
numbers) incompatible with the current test runner (`tests/hs-run-filtered.js`).
For now the test tree pins the pre-rewrite WASM. Resolving the ABI gap
is a separate task — either update the test runner to unwrap, or expose
a value-marshalling helper from the kernel.
**Phase 2: LRU cache (3-5 days)**
- Extract `Lambda.l_compiled` into central `sx_jit_cache.ml`

View File

@@ -87,12 +87,12 @@ 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] 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/` *[partial — pending second consumer]*
### Phase 7 — Propose `lib/guest/reflective/` *[env.sx EXTRACTED 2026-05-12; other five still pending]*
- [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`.
- [ ] Find a second consumer (Common-Lisp's macro-expansion evaluator? a metacircular Scheme variant? a future plan). Until this lands, extraction is blocked by the two-consumer rule.
- [ ] Only extract once two consumers exist (per stratification rule). **Do not extract from this loop** — Kernel is one consumer; we need another before `lib/guest/reflective/` is real.
- [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`).
- [ ] 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).
**Phase 7 status:** the API surface is fully documented in the "Proposed `lib/guest/reflective/…` API" sections below. 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:
1. **A metacircular Scheme** — Scheme can reuse `env.sx` directly (same scope semantics), borrow `evaluator.sx`'s eval/make-env/current-env triple, and pattern-match the `hygiene.sx` story (Scheme has identical lexical scope). Would NOT need `combiner.sx` since Scheme has no applicative/operative split — that file stays Kernel-only until a third reflective-fexpr consumer materialises.
2. **Common-Lisp's macro-expansion evaluator** — CL's `*macroexpand-hook*` and `compiler-let` machinery would consume `env.sx` (CL package envs map cleanly) and `evaluator.sx` (defmacro = an operative-like fexpr in expander phase). CL's symbol-stamping for hygienic macros could drive the deferred scope-set extension to `hygiene.sx`.

View File

@@ -0,0 +1,145 @@
# lib/guest/reflective/ — first extraction kit, driven by Tcl uplevel as second consumer
The `kernel-on-sx` loop accumulated six proposed `lib/guest/reflective/` files (`env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx`) but extraction was blocked on the two-consumer rule. This plan opens that block by selecting Tcl's `uplevel`/`upvar` machinery as the second consumer for the **`env.sx`** file specifically — the highest-fit candidate.
Why Tcl/uplevel for *env*: both Kernel and Tcl implement first-class scope chains with recursive parent-walking lookup, and both expose those scopes to user code (Kernel via `get-current-environment`; Tcl via `uplevel`/`upvar`). The first extraction is the smallest plausible kit that both can credibly use.
Why not the whole set in one go: the other five files (`combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx`) need consumers that exhibit *operative/applicative semantics*, which Tcl lacks. They stay deferred until a Scheme or Maru port lands.
## Discovery — current state, head-to-head
```
Kernel env Tcl frame
─────────────────────────────────────────────────────────────────────
shape {:knl-tag :env {:level N
:bindings DICT :locals DICT
:parent ENV-OR-NIL} :parent FRAME-OR-NIL}
update model MUTABLE (dict-set!) FUNCTIONAL (assoc returns new)
scope chain parent pointer parent pointer
+ explicit :frame-stack
on the interp
construction (kernel-make-env) (make-frame LEVEL PARENT)
(kernel-extend-env P)
lookup (kernel-env-lookup E N) (frame-lookup F N)
— raises on miss — returns nil on miss
bind (kernel-env-bind! E N V) (frame-set-top F N V)
— mutates — returns new frame
presence (kernel-env-has? E N) (frame-lookup F N) then nil-check
call-stack walk (nothing — only single chain) (tcl-frame-nth STACK LEVEL)
— indexes into :frame-stack
variable alias (nothing) (upvar-alias? V)
— alias dict points at
level + name in another frame
```
## The genuine overlap
The recursive parent-walk is identical in spirit. Both languages need:
1. A scope type with a *bindings dict* and *parent pointer*.
2. A *lookup* that walks parents until a hit (or nil/raise on miss).
3. A way to *extend* — push a fresh child frame.
4. A way to *write a binding* in a chosen frame.
The genuine divergence is *mutable vs functional update*. Tcl can't switch to mutable bindings without changing `frame-set-top`'s call sites (which return new interp state); Kernel can't switch to functional without rewriting `$define!` semantics (which mutates the dyn-env in place).
## The proposed API — adapter-driven, like `match.sx`
`lib/guest/match.sx` solves the same shape-divergence problem with a `cfg` adapter dict: the kit operates on a generic term representation, consumers pass callbacks that bridge their shape to it. The pattern works because the *algorithms* are language-agnostic; only the *data layout* differs.
`lib/guest/reflective/env.sx` should follow the same pattern.
```lisp
;; Canonical wire shape (default):
;; {:refl-tag :env :bindings DICT :parent ENV-OR-NIL}
;;
;; Adapter cfg keys (for consumers with their own shape):
;; :bindings-of — fn (scope) → DICT ; access bindings dict
;; :parent-of — fn (scope) → SCOPE-OR-NIL
;; :extend — fn (scope) → SCOPE ; child of scope
;; :bind! — fn (scope name val) → scope ; functional-or-mutable
;;
;; Default cfg (refl-default-cfg) implements the canonical wire shape
;; with MUTABLE bindings (dict-set!). Tcl provides its own cfg with
;; functional bindings and the level field preserved.
(refl-make-env) ;; canonical, mutable
(refl-extend-env PARENT)
(refl-env-bind! ENV NAME VAL) ;; mutates; returns ENV
(refl-env-has? ENV NAME)
(refl-env-lookup ENV NAME) ;; raises on miss
(refl-env-lookup-or-nil ENV NAME) ;; for guests that prefer nil
;; With explicit cfg — for consumers with their own shape:
(refl-env-lookup-with CFG SCOPE NAME)
(refl-env-bind!-with CFG SCOPE NAME VAL)
(refl-env-extend-with CFG SCOPE)
```
The two consumer migrations:
- **Kernel**: drops `kernel-make-env`, `kernel-extend-env`, `kernel-env-bind!`, `kernel-env-has?`, `kernel-env-lookup`. Replaces with `refl-*` calls on the canonical shape. Rename `:knl-tag``:refl-tag`. No semantic change.
- **Tcl**: keeps its `{:level :locals :parent}` shape but defines a Tcl-cfg adapter. `frame-lookup` becomes `(refl-env-lookup-with tcl-frame-cfg frame name)`. `frame-set-top` stays where it is — Tcl needs functional updates for the assoc-back-to-interp chain. The kit accommodates both, just like `match.sx` accommodates miniKanren's wire shape and Haskell's term shape.
## Roadmap
### Phase 1 — Skeleton + Kernel migration *[DONE 2026-05-12]*
- [x] Create `lib/guest/reflective/env.sx` with the canonical wire shape and mutable defaults.
- [x] Migrate `lib/kernel/eval.sx` to use `refl-make-env` / `refl-extend-env` / `refl-env-*`. Rename `:knl-tag``:refl-tag` in env values only (operatives/applicatives keep their own tags for now).
- [x] All 322 Kernel tests stay green.
### Phase 2 — Tcl adapter *[DONE 2026-05-12]*
- [x] Add `tcl-frame-cfg` in `lib/tcl/runtime.sx`. `frame-lookup` and `frame-set-top` now delegate to `refl-env-lookup-or-nil-with` / `refl-env-bind!-with`. Tcl's `{:level :locals :parent}` shape unchanged.
- [x] Tcl test suite green (427/427).
### Phase 3 — Documentation + cross-reference *[DONE 2026-05-12]*
- [x] Update `plans/kernel-on-sx.md` to mark Phase 7's *env.sx* extraction as DONE (one of six). Other five blocked.
- [x] `lib/guest/reflective/env.sx` header docstring already lists both consumers and links back to this plan.
### Phase 4 — Quick wins identified along the way
- [ ] Tcl's `tcl-frame-nth` (index into call stack by level) is the start of a *stack-frame protocol* — separate from the scope-chain protocol. Tcl needs it; Kernel doesn't. Document as "language-specific extension on top of the shared kit"; consider extracting later if a third consumer (Scheme `call-with-values`, CL `compiler-let`) needs frame-level indexing.
## Non-goals
- **Do not extract `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, or `short-circuit.sx`** in this branch. Tcl doesn't have operatives/applicatives; the two-consumer rule isn't satisfied for those files. They stay documented-only in `plans/kernel-on-sx.md` until a Scheme/Maru/CL-fexpr consumer arrives.
- **Do not change Tcl's update model to mutable**. The functional `frame-set-top` is structural — it's how Tcl threads the interp through `tcl-var-set`/`tcl-var-get`. Don't break it.
- **Do not unify the env-lookup error semantics**. Kernel raises; Tcl returns nil. The kit offers both (`refl-env-lookup` and `refl-env-lookup-or-nil`) and consumers pick.
## Validation criteria
The extraction is real iff:
1. Both consumers compile and pass their full test suites unchanged.
2. The shared `env.sx` file is ≥80 LoC (substantial enough to be worth sharing) and ≤200 LoC (small enough that the cfg adapter pattern doesn't become its own framework).
3. A third consumer in the future can adopt the kit by writing only the cfg dict — no algorithm changes to `env.sx`.
## Outcome (2026-05-12)
Three commits on `lib/tcl/uplevel`:
1. Plan committed.
2. **`reflective: extract env.sx + migrate Kernel — 322 tests green`** — kit landed; Kernel's env block collapsed from ~30 lines to 6 thin wrappers (`kernel-env? = refl-env?` etc.). Envs now carry `:refl-tag :env`. All 7 Kernel suites unchanged.
3. **`reflective: Tcl adapter cfg — second consumer wired, 427+322 tests green`** — `tcl-frame-cfg` defined, `frame-lookup`/`frame-set-top` delegate to the kit. Tcl's frame shape unchanged. Functional update preserved.
**File stats:** `lib/guest/reflective/env.sx` is 124 lines, 13 forms. Within the 80200 LoC validation bound. Adapter-cfg pattern proven to bridge mutable-canonical (Kernel) and functional-frame (Tcl) wire shapes via a single ~7-line cfg dict per consumer.
**Third-consumer test:** any future guest can adopt the kit by writing its own cfg with five keys (`:bindings-of`, `:parent-of`, `:extend`, `:bind!`, `:env?`) — no changes to `env.sx`. The shape-divergence problem is solved by parameterisation, not by forcing both consumers onto one wire shape.
## References
- `plans/kernel-on-sx.md` — the kernel-on-sx loop's chisel notes; the six candidate API surfaces are documented there.
- `lib/guest/match.sx` — precedent for the adapter-cfg extraction pattern.
- `lib/tcl/runtime.sx` lines 522 (`make-frame`, `frame-lookup`, `frame-set-top`) — the Tcl consumer's current implementation.
- `lib/kernel/eval.sx` lines 3982 (env block) — the Kernel consumer's current implementation.

View File

@@ -0,0 +1,216 @@
# miniKanren-on-SX: deferred work
The main plan (`plans/minikanren-on-sx.md`) carries Phases 17 through the
naive-tabling milestone. This file collects the four pieces left on the
shelf, with enough scope and design notes to drive a follow-up loop.
Branch convention: keep the same `loops/minikanren` worktree; commit and
push to `origin/loops/minikanren`. Squash-merge to `architecture` only
when each numbered piece is shipped + tests green.
Cumulative test count snapshot at squash-merge: **644** across
**71 test files**. Every change below should grow the number, not break
existing tests.
## The four pieces
### Piece A — Phase 7 SLG (cyclic patho, mutual recursion, fixed-point iteration)
**Problem.** Naive tabling drains the answer stream eagerly, then caches.
Recursive tabled calls with the SAME ground key see an empty cache (the
in-progress entry never exists), so they recurse and the host
overflows. Fibonacci works only because each recursive call has a
*different* key; cyclic `patho` and any genuinely self-recursive tabled
predicate diverge.
**Approach** — a small subset of SLG / OLDT resolution, enough to handle
the demos in the brief.
1. **In-progress sentinel.** When a tabled call `T(args)` starts, store
`(:in-progress nil)` under its key. Recursive calls into `T(args)`
from inside its own computation see the sentinel and return only
the answers accumulated so far (initially empty).
2. **Answer accumulator.** As each new answer is found, push it into
the cache entry: `(:in-progress accumulated-answers)`. After a
cycling caller returns, the outer continuation can re-consult the
updated cache.
3. **Fixed-point iteration.** The driver repeatedly re-runs the goal
until no new answers appear in a full pass, then transitions the
cache from `:in-progress` to `:done`.
4. **Subgoal table.** Track (subgoal, last-seen-cache-version) per
subscriber so each consumer only re-reads what it hasn't seen.
**Suggested artefacts.**
- `lib/minikanren/tabling-slg.sx` — new module with `table-slg-2`
(parallel to `table-2` from naive tabling). Keep `table-2` working
unchanged so Fibonacci/Ackermann don't regress.
- `lib/minikanren/tests/cyclic-graph-tabled.sx` — the canonical demo:
two-cycle `patho` from a→b→a→b plus a→b→c. With SLG, `(run* q
(tab-patho :a :c q))` returns the single shortest path, not divergence.
- `lib/minikanren/tests/mutual-recursion.sx` — even/odd via mutual
recursion (`even-o n``odd-o (n-1)`), tabled at both names.
**Reference reading.**
- TRS chapter on tabling.
- "Tabled Logic Programming" — Sagonas & Swift (the XSB / SLG paper).
- core.logic's `tabled` macro for an SX-dialect-friendly precedent.
**Risk.** This is the brief's "research-grade complexity, not a
one-iteration item". Plan for 46 commits: in-progress sentinel,
answer accumulator, fixed-point driver, then one demo per commit.
### Piece B — Phase 6 polish: bounds-consistency for `fd-plus` / `fd-times`
**Problem.** Current `fd-plus-prop` and `fd-times-prop` propagate only
when two of three operands walk to ground numbers. When all three are
domain-bounded vars, the propagator returns `s` unchanged — search has
to label down to ground before any narrowing happens.
**Approach** — narrow domains via interval reasoning even when no operand
is ground.
For `(fd-plus x y z)` with bounded x, y, z:
- `x ∈ [z.min y.max .. z.max y.min]`
- `y ∈ [z.min x.max .. z.max x.min]`
- `z ∈ [x.min + y.min .. x.max + y.max]`
For `(fd-times x y z)`: same shape, but with multiplication; need to
handle sign cases (negative domain ranges) and the divisor-when-not-zero
constraint already in place.
**Suggested artefacts.**
- Patch `fd-plus-prop` and `fd-times-prop` in `lib/minikanren/clpfd.sx`
with new `:else` branches that compute new domain bounds and call
`fd-set-domain` for each var.
- New tests in `lib/minikanren/tests/clpfd-plus.sx` /
`clpfd-times.sx` exercising the all-domain case: two domain-bounded
vars in the body of a goal, with no labelling, after which their
domains have narrowed.
- A demo: cryptarithmetic puzzle (see Piece D) using bounds
consistency to avoid labelling explosion.
**Risk.** Low. The math is well-known; just careful min/max arithmetic
and watch for edge cases (empty domain after narrowing).
### Piece C — `=/=` disequality with constraint store
**Problem.** `nafc` is sound only on ground args; `fd-neq` only on FD
domains. There is no general-purpose Prolog-style structural
disequality `=/=` that works on logic terms.
**Approach.** Generalise the FD constraint store to a uniform
"constraint store" that carries:
- domain map (existing)
- *pending disequalities* — a list of `(u v)` pairs that must remain
non-unifiable under any future extension.
After every `==` / `mk-unify`, re-check each pending disequality:
- If `(u v)` are now unifiable, fail.
- If they're now structurally distinct (no shared substitution can
unify), drop from the store (the constraint is satisfied).
- Otherwise leave in store.
**Where it bites.** The kernel currently uses `mk-unify` everywhere.
Either:
1. Replace `mk-unify` with a constraint-aware wrapper everywhere
(intrusive, but principled).
2. Keep `mk-unify` for goals that don't use `=/=`, and provide a
parallel `==-cs` / `=/=-cs` pair plus an alternative `run*-cs`
driver that fires the constraint check after each binding.
Option 2 mirrors the `fd-fire-store` pattern and stays out of the
common path.
**Suggested artefacts.**
- `lib/minikanren/diseq.sx` — disequality store on top of the
existing `_fd` reserved key (re-using the constraint list, just
with disequality-shaped closures instead of FD propagators).
- `=/=` goal that posts a disequality and immediately checks it.
- `=/=-test` integration: rewrite a few Phase 5 puzzles using `=/=`
instead of `nafc + ==`.
- Tests covering: ground-pair fail, partial-pair satisfied later by
binding, partial-pair *contradicted* later by binding.
**Risk.** Medium. The hard cases are *eventual* unifiability — a
disequality `(=/= (cons a 1) (cons 2 b))` should hold until both `a`
gets bound to `2` and `b` gets bound to `1`. Implementations like
core.logic's encode this as a list of "violating bindings" the
disequality remembers.
### Piece D — Bigger CLP(FD) demos: send-more-money + Sudoku 4×4
**Problem.** The current N-queens demo only verifies the constraint
chain end-to-end. The brief's full Phase 6 list includes
"send-more-money, N-queens with CLP(FD), map coloring,
cryptarithmetic" — most of which exercise *more* than just `fd-neq +
fd-distinct`.
**Approach.** Two concrete puzzles that both stress
bounds-consistency (Piece B) once it lands:
#### send-more-money
```
S E N D
+ M O R E
---------
M O N E Y
```
8 distinct digits ∈ {0..9}, S ≠ 0, M ≠ 0. Encoded as a sum-of-digits
equation using `fd-plus` + carry chains.
Without Piece B (bounds-consistency), the search labels every digit
combination upfront — slow but tractable on a fast machine. With
Piece B, the impossible high-digit cases prune early.
Test: a single solution `(9 5 6 7 1 0 8 2)`.
#### Sudoku 4×4
Easier than 9×9 but exercises the full pattern:
- 16 cells, each ∈ {1..4}
- 4 rows, 4 cols, 4 2×2 boxes — 12 `fd-distinct` constraints
- Some cells fixed as clues
A small solver should handle 4×4 in well under a second once
bounds-consistency narrows columns / boxes after each label step.
**Suggested artefacts.**
- `lib/minikanren/tests/send-more-money.sx` — single-solution test.
- `lib/minikanren/tests/sudoku-4x4.sx` — at least three cluesets:
unique solution, multiple solutions, no solution.
- Optional: `lib/minikanren/sudoku.sx` with a parameterised
`sudoku-n` for both 4×4 and a 9×9 stress test.
**Risk.** Lowmedium for 4×4 + send-more-money once Piece B lands.
9×9 Sudoku is a stretch; treat it as a stretch goal once the smaller
demos are green.
## Suggested ordering
1. **Piece B first** (bounds-consistency for `fd-plus` / `fd-times`).
Self-contained, low-risk, and unlocks Piece D's harder puzzles.
2. **Piece D** (the two demos). Validates Piece B with concrete
puzzles. Doubles as the brief's missing canary tests.
3. **Piece C** (`=/=`). Independent track; once shipped, refactor the
pet/diff puzzles in Phase 5 to use it instead of nafc.
4. **Piece A** (SLG tabling). Last because it's the highest-risk
piece; do it when the rest of the library is stable so regressions
are easy to spot.
## Operating ground rules (carry over from the original brief)
- **Scope:** `lib/minikanren/**` and the two plan files (this one and
the original).
- **Commit cadence:** one feature per commit. Short factual messages
(`mk: piece B — bounds-consistency for fd-plus`).
- **Plan updates:** tick boxes here as pieces land; mirror status in
`plans/minikanren-on-sx.md` Roadmap.
- **Test discipline:** every commit ends with the cumulative count
green. No-regression rule from the original brief still applies.
- **`sx-tree` MCP only** for `.sx` edits. `sx_validate` after every
structural edit.
- **Pushing:** `origin/loops/minikanren` only. Never `main`. Squash to
`architecture` only with explicit user permission, as we did for
the v1 merge.

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.