coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Phase 2: Move core spec files to spec/ and spec/tests/

Browse Source 
git mv eval.sx, parser.sx, primitives.sx, render.sx, cek.sx, frames.sx,
continuations.sx, callcc.sx, types.sx, special-forms.sx → spec/
Tests → spec/tests/
Both bootstrappers verified — find files via spec/ → web/ → shared/sx/ref/

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-15 02:12:13 +00:00
parent 8ed8134d66
commit 05f7b10864
28 changed files with 1 additions and 8792 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
shared/static/scripts/sx-browser.js
View File

@@ -14,7 +14,7 @@
// =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-03-15T00:53:02Z";
var SX_VERSION = "2026-03-15T02:11:58Z";
function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); }

245
shared/sx/ref/callcc.sx
View File

@@ -1,245 +0,0 @@
;; ==========================================================================
;; callcc.sx — Full first-class continuations (call/cc)
;;
;; OPTIONAL EXTENSION — not required by the core evaluator.
;; Bootstrappers include this only when the target supports it naturally.
;;
;; Full call/cc (call-with-current-continuation) captures the ENTIRE
;; remaining computation as a first-class function — not just up to a
;; delimiter, but all the way to the top level. Invoking a continuation
;; captured by call/cc abandons the current computation entirely and
;; resumes from where the continuation was captured.
;;
;; This is strictly more powerful than delimited continuations (shift/reset)
;; but harder to implement in targets that don't support it natively.
;; Recommended only for targets where it's natural:
;; - Scheme/Racket (native call/cc)
;; - Haskell (ContT monad transformer)
;;
;; For targets like Python, JavaScript, and Rust, delimited continuations
;; (continuations.sx) are more practical and cover the same use cases
;; without requiring a global CPS transform.
;;
;; One new special form:
;; (call/cc f) — call f with the current continuation
;;
;; One new type:
;; continuation — same type as in continuations.sx
;;
;; If both extensions are loaded, the continuation type is shared.
;; Delimited and undelimited continuations are the same type —
;; the difference is in how they are captured, not what they are.
;;
;; Platform requirements:
;; (make-continuation fn) — wrap a function as a continuation value
;; (continuation? x) — type predicate
;; (type-of continuation) → "continuation"
;; (call-with-cc f env) — target-specific call/cc implementation
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Semantics
;; --------------------------------------------------------------------------
;;
;; (call/cc f)
;;
;; Evaluates f (which must be a function of one argument), passing it the
;; current continuation as a continuation value. f can:
;;
;; a) Return normally — call/cc returns whatever f returns
;; b) Invoke the continuation — abandons f's computation, call/cc
;; "returns" the value passed to the continuation
;; c) Store the continuation — invoke it later, possibly multiple times
;;
;; Key difference from shift/reset: invoking an undelimited continuation
;; NEVER RETURNS to the caller. It abandons the current computation and
;; jumps back to where call/cc was originally called.
;;
;; ;; Delimited (shift/reset) — k returns a value:
;; (reset (+ 1 (shift k (+ (k 10) (k 20)))))
;; ;; (k 10) → 11, returns to the (+ ... (k 20)) expression
;; ;; (k 20) → 21, returns to the (+ 11 ...) expression
;; ;; result: 32
;;
;; ;; Undelimited (call/cc) — k does NOT return:
;; (+ 1 (call/cc (fn (k)
;; (+ (k 10) (k 20)))))
;; ;; (k 10) abandons (+ (k 10) (k 20)) entirely
;; ;; jumps back to (+ 1 _) with 10
;; ;; result: 11
;; ;; (k 20) is never reached
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 2. call/cc — call with current continuation
;; --------------------------------------------------------------------------
(define sf-callcc
(fn (args env)
;; Single argument: a function to call with the current continuation.
(let ((f-expr (first args))
(f (trampoline (eval-expr f-expr env))))
(call-with-cc f env))))
;; --------------------------------------------------------------------------
;; 3. Derived forms
;; --------------------------------------------------------------------------
;;
;; With call/cc available, several patterns become expressible:
;;
;; --- Early return ---
;;
;; (define find-first
;; (fn (pred items)
;; (call/cc (fn (return)
;; (for-each (fn (item)
;; (when (pred item)
;; (return item)))
;; items)
;; nil))))
;;
;; --- Exception-like flow ---
;;
;; (define try-catch
;; (fn (body handler)
;; (call/cc (fn (throw)
;; (body throw)))))
;;
;; (try-catch
;; (fn (throw)
;; (let ((result (dangerous-operation)))
;; (when (not result) (throw "failed"))
;; result))
;; (fn (error) (str "Caught: " error)))
;;
;; --- Coroutines ---
;;
;; Two call/cc captures that alternate control between two
;; computations. Each captures its own continuation, then invokes
;; the other's. This gives cooperative multitasking without threads.
;;
;; --- Undo ---
;;
;; (define with-undo
;; (fn (action)
;; (call/cc (fn (restore)
;; (action)
;; restore))))
;;
;; ;; (let ((undo (with-undo (fn () (delete-item 42)))))
;; ;; (undo "anything")) → item 42 is back
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 4. Interaction with delimited continuations
;; --------------------------------------------------------------------------
;;
;; If both callcc.sx and continuations.sx are loaded:
;;
;; - The continuation type is shared. (continuation? k) returns true
;; for both delimited and undelimited continuations.
;;
;; - shift inside a call/cc body captures up to the nearest reset,
;; not up to the call/cc. The two mechanisms compose.
;;
;; - call/cc inside a reset body captures the entire continuation
;; (past the reset). This is the expected behavior — call/cc is
;; undelimited by definition.
;;
;; - A delimited continuation (from shift) returns a value when invoked.
;; An undelimited continuation (from call/cc) does not return.
;; Both are callable with the same syntax: (k value).
;; The caller cannot distinguish them by type — only by behavior.
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 5. Interaction with I/O and state
;; --------------------------------------------------------------------------
;;
;; Full call/cc has well-known interactions with side effects:
;;
;; Re-entry:
;; Invoking a saved continuation re-enters a completed computation.
;; If that computation mutated state (set!, I/O writes), the mutations
;; are NOT undone. The continuation resumes in the current state,
;; not the state at the time of capture.
;;
;; I/O:
;; Same as delimited continuations — I/O executes at invocation time.
;; A continuation containing (current-user) will call current-user
;; when invoked, in whatever request context exists then.
;;
;; Dynamic extent:
;; call/cc captures the continuation, not the dynamic environment.
;; Host-language context (Python's Quart request context, JavaScript's
;; async context) may not be valid when a saved continuation is invoked
;; later. Typed targets can enforce this; dynamic targets fail at runtime.
;;
;; Recommendation:
;; Use call/cc for pure control flow (early return, coroutines,
;; backtracking). Use delimited continuations for effectful patterns
;; (suspense, cooperative scheduling) where the delimiter provides
;; a natural boundary.
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 6. Implementation notes per target
;; --------------------------------------------------------------------------
;;
;; Scheme / Racket:
;; Native call/cc. Zero implementation effort.
;;
;; Haskell:
;; ContT monad transformer. The evaluator runs in ContT, and call/cc
;; is callCC from Control.Monad.Cont. Natural and type-safe.
;;
;; Python:
;; Requires full CPS transform of the evaluator, or greenlet-based
;; stack capture. Significantly more invasive than delimited
;; continuations. NOT RECOMMENDED — use continuations.sx instead.
;;
;; JavaScript:
;; Requires full CPS transform. Cannot be implemented with generators
;; alone (generators only support delimited yield, not full escape).
;; NOT RECOMMENDED — use continuations.sx instead.
;;
;; Rust:
;; Full CPS transform at compile time. Possible but adds significant
;; complexity. Delimited continuations are more natural (enum-based).
;; Consider only if the target genuinely needs undelimited escape.
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 7. Platform interface — what each target must provide
;; --------------------------------------------------------------------------
;;
;; (call-with-cc f env)
;; Call f with the current continuation. f is a function of one
;; argument (the continuation). If f returns normally, call-with-cc
;; returns f's result. If f invokes the continuation, the computation
;; jumps to the call-with-cc call site with the provided value.
;;
;; (make-continuation fn)
;; Wrap a native function as a continuation value.
;; (Shared with continuations.sx if both are loaded.)
;;
;; (continuation? x)
;; Type predicate.
;; (Shared with continuations.sx if both are loaded.)
;;
;; Continuations must be callable via the standard function-call
;; dispatch in eval-list (same path as lambda calls).
;;
;; --------------------------------------------------------------------------

1178
shared/sx/ref/cek.sx
View File

File diff suppressed because it is too large Load Diff

248
shared/sx/ref/continuations.sx
View File

@@ -1,248 +0,0 @@
;; ==========================================================================
;; continuations.sx — Delimited continuations (shift/reset)
;;
;; OPTIONAL EXTENSION — not required by the core evaluator.
;; Bootstrappers include this only when the target requests it.
;;
;; Delimited continuations capture "the rest of the computation up to
;; a delimiter." They are strictly less powerful than full call/cc but
;; cover the practical use cases: suspendable rendering, cooperative
;; scheduling, linear async flows, wizard forms, and undo.
;;
;; Two new special forms:
;; (reset body) — establish a delimiter
;; (shift k body) — capture the continuation to the nearest reset
;;
;; One new type:
;; continuation — a captured delimited continuation, callable
;;
;; The captured continuation is a function of one argument. Invoking it
;; provides the value that the shift expression "returns" within the
;; delimited context, then completes the rest of the reset body.
;;
;; Continuations are composable — invoking a continuation returns a
;; value (the result of the reset body), which can be used normally.
;; This is the key difference from undelimited call/cc, where invoking
;; a continuation never returns.
;;
;; Platform requirements:
;; (make-continuation fn) — wrap a function as a continuation value
;; (continuation? x) — type predicate
;; (type-of continuation) → "continuation"
;; Continuations are callable (same dispatch as lambda).
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Type
;; --------------------------------------------------------------------------
;;
;; A continuation is a callable value of one argument.
;;
;; (continuation? k) → true if k is a captured continuation
;; (type-of k) → "continuation"
;; (k value) → invoke: resume the captured computation with value
;;
;; Continuations are first-class: they can be stored in variables, passed
;; as arguments, returned from functions, and put in data structures.
;;
;; Invoking a delimited continuation RETURNS a value — the result of the
;; reset body. This makes them composable:
;;
;; (+ 1 (reset (+ 10 (shift k (k 5)))))
;; ;; k is "add 10 to _ and return from reset"
;; ;; (k 5) → 15, which is returned from reset
;; ;; (+ 1 15) → 16
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 2. reset — establish a continuation delimiter
;; --------------------------------------------------------------------------
;;
;; (reset body)
;;
;; Evaluates body in the current environment. If no shift occurs during
;; evaluation of body, reset simply returns the value of body.
;;
;; If shift occurs, reset is the boundary — the continuation captured by
;; shift extends from the shift point back to (and including) this reset.
;;
;; reset is the "prompt" — it marks where the continuation stops.
;;
;; Semantics:
;; (reset expr) where expr contains no shift
;; → (eval expr env) ;; just evaluates normally
;;
;; (reset ... (shift k body) ...)
;; → captures continuation, evaluates shift's body
;; → the result of the shift body is the result of the reset
;;
;; --------------------------------------------------------------------------
(define sf-reset
(fn ((args :as list) (env :as dict))
;; Single argument: the body expression.
;; Install a continuation delimiter, then evaluate body.
;; The implementation is target-specific:
;; - In Scheme: native reset/shift
;; - In Haskell: Control.Monad.CC or delimited continuations library
;; - In Python: coroutine/generator-based (see implementation notes)
;; - In JavaScript: generator-based or CPS transform
;; - In Rust: CPS transform at compile time
(let ((body (first args)))
(eval-with-delimiter body env))))
;; --------------------------------------------------------------------------
;; 3. shift — capture the continuation to the nearest reset
;; --------------------------------------------------------------------------
;;
;; (shift k body)
;;
;; Captures the continuation from this point back to the nearest enclosing
;; reset and binds it to k. Then evaluates body in the current environment
;; extended with k. The result of body becomes the result of the enclosing
;; reset.
;;
;; k is a function of one argument. Calling (k value) resumes the captured
;; computation with value standing in for the shift expression.
;;
;; The continuation k is composable: (k value) returns a value (the result
;; of the reset body when resumed with value). This means k can be called
;; multiple times, and its result can be used in further computation.
;;
;; Examples:
;;
;; ;; Basic: shift provides a value to the surrounding computation
;; (reset (+ 1 (shift k (k 41))))
;; ;; k = "add 1 to _", (k 41) → 42, reset returns 42
;;
;; ;; Abort: shift can discard the continuation entirely
;; (reset (+ 1 (shift k "aborted")))
;; ;; k is never called, reset returns "aborted"
;;
;; ;; Multiple invocations: k can be called more than once
;; (reset (+ 1 (shift k (list (k 10) (k 20)))))
;; ;; (k 10) → 11, (k 20) → 21, reset returns (11 21)
;;
;; ;; Stored for later: k can be saved and invoked outside reset
;; (define saved nil)
;; (reset (+ 1 (shift k (set! saved k) 0)))
;; ;; reset returns 0, saved holds the continuation
;; (saved 99) ;; → 100
;;
;; --------------------------------------------------------------------------
(define sf-shift
(fn ((args :as list) (env :as dict))
;; Two arguments: the continuation variable name, and the body.
(let ((k-name (symbol-name (first args)))
(body (second args)))
;; Capture the current continuation up to the nearest reset.
;; Bind it to k-name in the environment, then evaluate body.
;; The result of body is returned to the reset.
(capture-continuation k-name body env))))
;; --------------------------------------------------------------------------
;; 4. Interaction with other features
;; --------------------------------------------------------------------------
;;
;; TCO (trampoline):
;; Continuations interact naturally with the trampoline. A shift inside
;; a tail-call position captures the continuation including the pending
;; return. The trampoline resolves thunks before the continuation is
;; delimited.
;;
;; Macros:
;; shift/reset are special forms, not macros. Macros expand before
;; evaluation, so shift inside a macro-expanded form works correctly —
;; it captures the continuation of the expanded code.
;;
;; Components:
;; shift inside a component body captures the continuation of that
;; component's render. The enclosing reset determines the delimiter.
;; This is the foundation for suspendable rendering — a component can
;; shift to suspend, and the server resumes it when data arrives.
;;
;; I/O primitives:
;; I/O primitives execute at invocation time, in whatever context
;; exists then. A continuation that captures a computation containing
;; I/O will re-execute that I/O when invoked. If the I/O requires
;; request context (e.g. current-user), invoking the continuation
;; outside a request will fail — same as calling the I/O directly.
;; This is consistent, not a restriction.
;;
;; In typed targets (Haskell, Rust), the type system can enforce that
;; continuations containing I/O are only invoked in appropriate contexts.
;; In dynamic targets (Python, JS), it fails at runtime.
;;
;; Lexical scope:
;; Continuations capture the dynamic extent (what happens next) but
;; close over the lexical environment at the point of capture. Variable
;; bindings in the continuation refer to the same environment — mutations
;; via set! are visible.
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 5. Implementation notes per target
;; --------------------------------------------------------------------------
;;
;; The bootstrapper emits target-specific continuation machinery.
;; The spec defines semantics; each target chooses representation.
;;
;; Scheme / Racket:
;; Native shift/reset. No transformation needed. The bootstrapper
;; emits (require racket/control) or equivalent.
;;
;; Haskell:
;; Control.Monad.CC provides delimited continuations in the CC monad.
;; Alternatively, the evaluator can be CPS-transformed at compile time.
;; Continuations become first-class functions naturally.
;;
;; Python:
;; Generator-based: reset creates a generator, shift yields from it.
;; The trampoline loop drives the generator. Each yield is a shift
;; point, and send() provides the resume value.
;; Alternative: greenlet-based (stackful coroutines).
;;
;; JavaScript:
;; Generator-based (function* / yield). Similar to Python.
;; Alternative: CPS transform at bootstrap time — the bootstrapper
;; rewrites the evaluator into continuation-passing style, making
;; shift/reset explicit function arguments.
;;
;; Rust:
;; CPS transform at compile time. Continuations become enum variants
;; or boxed closures. The type system ensures continuations are used
;; linearly if desired (affine types via ownership).
;;
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; 6. Platform interface — what each target must provide
;; --------------------------------------------------------------------------
;;
;; (eval-with-delimiter expr env)
;; Install a reset delimiter, evaluate expr, return result.
;; If expr calls shift, the continuation is captured up to here.
;;
;; (capture-continuation k-name body env)
;; Capture the current continuation up to the nearest delimiter.
;; Bind it to k-name in env, evaluate body, return result to delimiter.
;;
;; (make-continuation fn)
;; Wrap a native function as a continuation value.
;;
;; (continuation? x)
;; Type predicate.
;;
;; Continuations must be callable via the standard function-call
;; dispatch in eval-list (same path as lambda calls).
;;
;; --------------------------------------------------------------------------

1184
shared/sx/ref/eval.sx
View File

File diff suppressed because it is too large Load Diff

262
shared/sx/ref/frames.sx
View File

@@ -1,262 +0,0 @@
;; ==========================================================================
;; frames.sx — CEK machine frame types
;;
;; Defines the continuation frame types used by the explicit CEK evaluator.
;; Each frame represents a "what to do next" when a sub-evaluation completes.
;;
;; A CEK state is a dict:
;; {:control expr — expression being evaluated (or nil in continue phase)
;; :env env — current environment
;; :kont list — continuation: list of frames (stack, head = top)
;; :phase "eval"|"continue"
;; :value any} — value produced (only in continue phase)
;;
;; Two-phase step function:
;; step-eval: control is expression → dispatch → push frame + new control
;; step-continue: value produced → pop frame → dispatch → new state
;;
;; Terminal state: phase = "continue" and kont is empty → value is final result.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. CEK State constructors
;; --------------------------------------------------------------------------
(define make-cek-state
(fn (control env kont)
{:control control :env env :kont kont :phase "eval" :value nil}))
(define make-cek-value
(fn (value env kont)
{:control nil :env env :kont kont :phase "continue" :value value}))
(define cek-terminal?
(fn (state)
(and (= (get state "phase") "continue")
(empty? (get state "kont")))))
(define cek-control (fn (s) (get s "control")))
(define cek-env (fn (s) (get s "env")))
(define cek-kont (fn (s) (get s "kont")))
(define cek-phase (fn (s) (get s "phase")))
(define cek-value (fn (s) (get s "value")))
;; --------------------------------------------------------------------------
;; 2. Frame constructors
;; --------------------------------------------------------------------------
;; Each frame type is a dict with a "type" key and frame-specific data.
;; IfFrame: waiting for condition value
;; After condition evaluates, choose then or else branch
(define make-if-frame
(fn (then-expr else-expr env)
{:type "if" :then then-expr :else else-expr :env env}))
;; WhenFrame: waiting for condition value
;; If truthy, evaluate body exprs sequentially
(define make-when-frame
(fn (body-exprs env)
{:type "when" :body body-exprs :env env}))
;; BeginFrame: sequential evaluation
;; Remaining expressions to evaluate after current one
(define make-begin-frame
(fn (remaining env)
{:type "begin" :remaining remaining :env env}))
;; LetFrame: binding evaluation in progress
;; name = current binding name, remaining = remaining (name val) pairs
;; body = body expressions to evaluate after all bindings
(define make-let-frame
(fn (name remaining body local)
{:type "let" :name name :remaining remaining :body body :env local}))
;; DefineFrame: waiting for value to bind
(define make-define-frame
(fn (name env has-effects effect-list)
{:type "define" :name name :env env
:has-effects has-effects :effect-list effect-list}))
;; SetFrame: waiting for value to assign
(define make-set-frame
(fn (name env)
{:type "set" :name name :env env}))
;; ArgFrame: evaluating function arguments
;; f = function value (already evaluated), evaled = already evaluated args
;; remaining = remaining arg expressions
(define make-arg-frame
(fn (f evaled remaining env raw-args)
{:type "arg" :f f :evaled evaled :remaining remaining :env env
:raw-args raw-args}))
;; CallFrame: about to call with fully evaluated args
(define make-call-frame
(fn (f args env)
{:type "call" :f f :args args :env env}))
;; CondFrame: evaluating cond clauses
(define make-cond-frame
(fn (remaining env scheme?)
{:type "cond" :remaining remaining :env env :scheme scheme?}))
;; CaseFrame: evaluating case clauses
(define make-case-frame
(fn (match-val remaining env)
{:type "case" :match-val match-val :remaining remaining :env env}))
;; ThreadFirstFrame: pipe threading
(define make-thread-frame
(fn (remaining env)
{:type "thread" :remaining remaining :env env}))
;; MapFrame: higher-order map/map-indexed in progress
(define make-map-frame
(fn (f remaining results env)
{:type "map" :f f :remaining remaining :results results :env env :indexed false}))
(define make-map-indexed-frame
(fn (f remaining results env)
{:type "map" :f f :remaining remaining :results results :env env :indexed true}))
;; FilterFrame: higher-order filter in progress
(define make-filter-frame
(fn (f remaining results current-item env)
{:type "filter" :f f :remaining remaining :results results
:current-item current-item :env env}))
;; ReduceFrame: higher-order reduce in progress
(define make-reduce-frame
(fn (f remaining env)
{:type "reduce" :f f :remaining remaining :env env}))
;; ForEachFrame: higher-order for-each in progress
(define make-for-each-frame
(fn (f remaining env)
{:type "for-each" :f f :remaining remaining :env env}))
;; SomeFrame: higher-order some (short-circuit on first truthy)
(define make-some-frame
(fn (f remaining env)
{:type "some" :f f :remaining remaining :env env}))
;; EveryFrame: higher-order every? (short-circuit on first falsy)
(define make-every-frame
(fn (f remaining env)
{:type "every" :f f :remaining remaining :env env}))
;; ScopeFrame: scope-pop! when frame pops
(define make-scope-frame
(fn (name remaining env)
{:type "scope" :name name :remaining remaining :env env}))
;; ResetFrame: delimiter for shift/reset continuations
(define make-reset-frame
(fn (env)
{:type "reset" :env env}))
;; DictFrame: evaluating dict values
(define make-dict-frame
(fn (remaining results env)
{:type "dict" :remaining remaining :results results :env env}))
;; AndFrame: short-circuit and
(define make-and-frame
(fn (remaining env)
{:type "and" :remaining remaining :env env}))
;; OrFrame: short-circuit or
(define make-or-frame
(fn (remaining env)
{:type "or" :remaining remaining :env env}))
;; QuasiquoteFrame (not a real frame — QQ is handled specially)
;; DynamicWindFrame: phases of dynamic-wind
(define make-dynamic-wind-frame
(fn (phase body-thunk after-thunk env)
{:type "dynamic-wind" :phase phase
:body-thunk body-thunk :after-thunk after-thunk :env env}))
;; ReactiveResetFrame: delimiter for reactive deref-as-shift
;; Carries an update-fn that gets called with new values on re-render.
(define make-reactive-reset-frame
(fn (env update-fn first-render?)
{:type "reactive-reset" :env env :update-fn update-fn
:first-render first-render?}))
;; DerefFrame: awaiting evaluation of deref's argument
(define make-deref-frame
(fn (env)
{:type "deref" :env env}))
;; --------------------------------------------------------------------------
;; 3. Frame accessors
;; --------------------------------------------------------------------------
(define frame-type (fn (f) (get f "type")))
;; --------------------------------------------------------------------------
;; 4. Continuation operations
;; --------------------------------------------------------------------------
(define kont-push
(fn (frame kont) (cons frame kont)))
(define kont-top
(fn (kont) (first kont)))
(define kont-pop
(fn (kont) (rest kont)))
(define kont-empty?
(fn (kont) (empty? kont)))
;; --------------------------------------------------------------------------
;; 5. CEK shift/reset support
;; --------------------------------------------------------------------------
;; shift captures all frames up to the nearest ResetFrame.
;; reset pushes a ResetFrame.
(define kont-capture-to-reset
(fn (kont)
;; Returns (captured-frames remaining-kont).
;; captured-frames: frames from top up to (not including) ResetFrame.
;; remaining-kont: frames after ResetFrame.
;; Stops at either "reset" or "reactive-reset" frames.
(define scan
(fn (k captured)
(if (empty? k)
(error "shift without enclosing reset")
(let ((frame (first k)))
(if (or (= (frame-type frame) "reset")
(= (frame-type frame) "reactive-reset"))
(list captured (rest k))
(scan (rest k) (append captured (list frame))))))))
(scan kont (list))))
;; Check if a ReactiveResetFrame exists anywhere in the continuation
(define has-reactive-reset-frame?
(fn (kont)
(if (empty? kont) false
(if (= (frame-type (first kont)) "reactive-reset") true
(has-reactive-reset-frame? (rest kont))))))
;; Capture frames up to nearest ReactiveResetFrame.
;; Returns (captured-frames, reset-frame, remaining-kont).
(define kont-capture-to-reactive-reset
(fn (kont)
(define scan
(fn (k captured)
(if (empty? k)
(error "reactive deref without enclosing reactive-reset")
(let ((frame (first k)))
(if (= (frame-type frame) "reactive-reset")
(list captured frame (rest k))
(scan (rest k) (append captured (list frame))))))))
(scan kont (list))))

418
shared/sx/ref/parser.sx
View File

@@ -1,418 +0,0 @@
;; ==========================================================================
;; parser.sx — Reference SX parser specification
;;
;; Defines how SX source text is tokenized and parsed into AST.
;; The parser is intentionally simple — s-expressions need minimal parsing.
;;
;; Single-pass recursive descent: reads source text directly into AST,
;; no separate tokenization phase. All mutable cursor state lives inside
;; the parse closure.
;;
;; Grammar:
;; program → expr*
;; expr → atom | list | vector | map | quote-sugar
;; list → '(' expr* ')'
;; vector → '[' expr* ']' (sugar for list)
;; map → '{' (key expr)* '}'
;; atom → string | number | keyword | symbol | boolean | nil
;; string → '"' (char | escape)* '"'
;; number → '-'? digit+ ('.' digit+)? ([eE] [+-]? digit+)?
;; keyword → ':' ident
;; symbol → ident
;; boolean → 'true' | 'false'
;; nil → 'nil'
;; ident → ident-start ident-char*
;; comment → ';' to end of line (discarded)
;;
;; Quote sugar:
;; 'expr → (quote expr)
;; `expr → (quasiquote expr)
;; ,expr → (unquote expr)
;; ,@expr → (splice-unquote expr)
;;
;; Reader macros:
;; #;expr → datum comment (read and discard expr)
;; #|raw chars| → raw string literal (no escape processing)
;; #'expr → (quote expr)
;; #name expr → extensible dispatch (calls registered handler)
;;
;; Platform interface (each target implements natively):
;; (ident-start? ch) → boolean
;; (ident-char? ch) → boolean
;; (make-symbol name) → Symbol value
;; (make-keyword name) → Keyword value
;; (escape-string s) → string with " and \ escaped for serialization
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Parser — single-pass recursive descent
;; --------------------------------------------------------------------------
;; Returns a list of top-level AST expressions.
(define sx-parse :effects []
(fn ((source :as string))
(let ((pos 0)
(len-src (len source)))
;; -- Cursor helpers (closure over pos, source, len-src) --
(define skip-comment :effects []
(fn ()
(when (and (< pos len-src) (not (= (nth source pos) "\n")))
(set! pos (inc pos))
(skip-comment))))
(define skip-ws :effects []
(fn ()
(when (< pos len-src)
(let ((ch (nth source pos)))
(cond
;; Whitespace
(or (= ch " ") (= ch "\t") (= ch "\n") (= ch "\r"))
(do (set! pos (inc pos)) (skip-ws))
;; Comment — skip to end of line
(= ch ";")
(do (set! pos (inc pos))
(skip-comment)
(skip-ws))
;; Not whitespace or comment — stop
:else nil)))))
;; -- Atom readers --
(define hex-digit-value :effects []
(fn (ch) (index-of "0123456789abcdef" (lower ch))))
(define read-string :effects []
(fn ()
(set! pos (inc pos)) ;; skip opening "
(let ((buf ""))
(define read-str-loop :effects []
(fn ()
(if (>= pos len-src)
(error "Unterminated string")
(let ((ch (nth source pos)))
(cond
(= ch "\"")
(do (set! pos (inc pos)) nil) ;; done
(= ch "\\")
(do (set! pos (inc pos))
(let ((esc (nth source pos)))
(if (= esc "u")
;; Unicode escape: \uXXXX → char
(do (set! pos (inc pos))
(let ((d0 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d1 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d2 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d3 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos))))
(set! buf (str buf (char-from-code
(+ (* d0 4096) (* d1 256) (* d2 16) d3))))
(read-str-loop)))
;; Standard escapes: \n \t \r or literal
(do (set! buf (str buf
(cond
(= esc "n") "\n"
(= esc "t") "\t"
(= esc "r") "\r"
:else esc)))
(set! pos (inc pos))
(read-str-loop)))))
:else
(do (set! buf (str buf ch))
(set! pos (inc pos))
(read-str-loop)))))))
(read-str-loop)
buf)))
(define read-ident :effects []
(fn ()
(let ((start pos))
(define read-ident-loop :effects []
(fn ()
(when (and (< pos len-src)
(ident-char? (nth source pos)))
(set! pos (inc pos))
(read-ident-loop))))
(read-ident-loop)
(slice source start pos))))
(define read-keyword :effects []
(fn ()
(set! pos (inc pos)) ;; skip :
(make-keyword (read-ident))))
(define read-number :effects []
(fn ()
(let ((start pos))
;; Optional leading minus
(when (and (< pos len-src) (= (nth source pos) "-"))
(set! pos (inc pos)))
;; Integer digits
(define read-digits :effects []
(fn ()
(when (and (< pos len-src)
(let ((c (nth source pos)))
(and (>= c "0") (<= c "9"))))
(set! pos (inc pos))
(read-digits))))
(read-digits)
;; Decimal part
(when (and (< pos len-src) (= (nth source pos) "."))
(set! pos (inc pos))
(read-digits))
;; Exponent
(when (and (< pos len-src)
(or (= (nth source pos) "e")
(= (nth source pos) "E")))
(set! pos (inc pos))
(when (and (< pos len-src)
(or (= (nth source pos) "+")
(= (nth source pos) "-")))
(set! pos (inc pos)))
(read-digits))
(parse-number (slice source start pos)))))
(define read-symbol :effects []
(fn ()
(let ((name (read-ident)))
(cond
(= name "true") true
(= name "false") false
(= name "nil") nil
:else (make-symbol name)))))
;; -- Composite readers --
(define read-list :effects []
(fn ((close-ch :as string))
(let ((items (list)))
(define read-list-loop :effects []
(fn ()
(skip-ws)
(if (>= pos len-src)
(error "Unterminated list")
(if (= (nth source pos) close-ch)
(do (set! pos (inc pos)) nil) ;; done
(do (append! items (read-expr))
(read-list-loop))))))
(read-list-loop)
items)))
(define read-map :effects []
(fn ()
(let ((result (dict)))
(define read-map-loop :effects []
(fn ()
(skip-ws)
(if (>= pos len-src)
(error "Unterminated map")
(if (= (nth source pos) "}")
(do (set! pos (inc pos)) nil) ;; done
(let ((key-expr (read-expr))
(key-str (if (= (type-of key-expr) "keyword")
(keyword-name key-expr)
(str key-expr)))
(val-expr (read-expr)))
(dict-set! result key-str val-expr)
(read-map-loop))))))
(read-map-loop)
result)))
;; -- Raw string reader (for #|...|) --
(define read-raw-string :effects []
(fn ()
(let ((buf ""))
(define raw-loop :effects []
(fn ()
(if (>= pos len-src)
(error "Unterminated raw string")
(let ((ch (nth source pos)))
(if (= ch "|")
(do (set! pos (inc pos)) nil) ;; done
(do (set! buf (str buf ch))
(set! pos (inc pos))
(raw-loop)))))))
(raw-loop)
buf)))
;; -- Main expression reader --
(define read-expr :effects []
(fn ()
(skip-ws)
(if (>= pos len-src)
(error "Unexpected end of input")
(let ((ch (nth source pos)))
(cond
;; Lists
(= ch "(")
(do (set! pos (inc pos)) (read-list ")"))
(= ch "[")
(do (set! pos (inc pos)) (read-list "]"))
;; Map
(= ch "{")
(do (set! pos (inc pos)) (read-map))
;; String
(= ch "\"")
(read-string)
;; Keyword
(= ch ":")
(read-keyword)
;; Quote sugar
(= ch "'")
(do (set! pos (inc pos))
(list (make-symbol "quote") (read-expr)))
;; Quasiquote sugar
(= ch "`")
(do (set! pos (inc pos))
(list (make-symbol "quasiquote") (read-expr)))
;; Unquote / splice-unquote
(= ch ",")
(do (set! pos (inc pos))
(if (and (< pos len-src) (= (nth source pos) "@"))
(do (set! pos (inc pos))
(list (make-symbol "splice-unquote") (read-expr)))
(list (make-symbol "unquote") (read-expr))))
;; Reader macros: #
(= ch "#")
(do (set! pos (inc pos))
(if (>= pos len-src)
(error "Unexpected end of input after #")
(let ((dispatch-ch (nth source pos)))
(cond
;; #; — datum comment: read and discard next expr
(= dispatch-ch ";")
(do (set! pos (inc pos))
(read-expr) ;; read and discard
(read-expr)) ;; return the NEXT expr
;; #| — raw string
(= dispatch-ch "|")
(do (set! pos (inc pos))
(read-raw-string))
;; #' — quote shorthand
(= dispatch-ch "'")
(do (set! pos (inc pos))
(list (make-symbol "quote") (read-expr)))
;; #name — extensible dispatch
(ident-start? dispatch-ch)
(let ((macro-name (read-ident)))
(let ((handler (reader-macro-get macro-name)))
(if handler
(handler (read-expr))
(error (str "Unknown reader macro: #" macro-name)))))
:else
(error (str "Unknown reader macro: #" dispatch-ch))))))
;; Number (or negative number)
(or (and (>= ch "0") (<= ch "9"))
(and (= ch "-")
(< (inc pos) len-src)
(let ((next-ch (nth source (inc pos))))
(and (>= next-ch "0") (<= next-ch "9")))))
(read-number)
;; Ellipsis (... as a symbol)
(and (= ch ".")
(< (+ pos 2) len-src)
(= (nth source (+ pos 1)) ".")
(= (nth source (+ pos 2)) "."))
(do (set! pos (+ pos 3))
(make-symbol "..."))
;; Symbol (must be ident-start char)
(ident-start? ch)
(read-symbol)
;; Unexpected
:else
(error (str "Unexpected character: " ch)))))))
;; -- Entry point: parse all top-level expressions --
(let ((exprs (list)))
(define parse-loop :effects []
(fn ()
(skip-ws)
(when (< pos len-src)
(append! exprs (read-expr))
(parse-loop))))
(parse-loop)
exprs))))
;; --------------------------------------------------------------------------
;; Serializer — AST → SX source text
;; --------------------------------------------------------------------------
(define sx-serialize :effects []
(fn (val)
(case (type-of val)
"nil" "nil"
"boolean" (if val "true" "false")
"number" (str val)
"string" (str "\"" (escape-string val) "\"")
"symbol" (symbol-name val)
"keyword" (str ":" (keyword-name val))
"list" (str "(" (join " " (map sx-serialize val)) ")")
"dict" (sx-serialize-dict val)
"sx-expr" (sx-expr-source val)
"spread" (str "(make-spread " (sx-serialize-dict (spread-attrs val)) ")")
:else (str val))))
(define sx-serialize-dict :effects []
(fn ((d :as dict))
(str "{"
(join " "
(reduce
(fn ((acc :as list) (key :as string))
(concat acc (list (str ":" key) (sx-serialize (dict-get d key)))))
(list)
(keys d)))
"}")))
;; Alias: adapters use (serialize val) — canonicalize to sx-serialize
(define serialize sx-serialize)
;; --------------------------------------------------------------------------
;; Platform parser interface
;; --------------------------------------------------------------------------
;;
;; Character classification (implemented natively per target):
;; (ident-start? ch) → boolean
;; True for: a-z A-Z _ ~ * + - > < = / ! ? &
;;
;; (ident-char? ch) → boolean
;; True for: ident-start chars plus: 0-9 . : / # ,
;;
;; Constructors (provided by the SX runtime):
;; (make-symbol name) → Symbol value
;; (make-keyword name) → Keyword value
;; (parse-number s) → number (int or float from string)
;;
;; String utilities:
;; (escape-string s) → string with " and \ escaped
;; (sx-expr-source e) → unwrap SxExpr to its source string
;;
;; Reader macro registry:
;; (reader-macro-get name) → handler fn or nil
;; (reader-macro-set! name handler) → register a reader macro
;; --------------------------------------------------------------------------

607
shared/sx/ref/primitives.sx
View File

@@ -1,607 +0,0 @@
;; ==========================================================================
;; primitives.sx — Specification of all SX built-in pure functions
;;
;; Each entry declares: name, parameter signature, and semantics.
;; Bootstrap compilers implement these natively per target.
;;
;; This file is a SPECIFICATION, not executable code. The define-primitive
;; form is a declarative macro that bootstrap compilers consume to generate
;; native primitive registrations.
;;
;; Format:
;; (define-primitive "name"
;; :params (param1 param2 &rest rest)
;; :returns "type"
;; :doc "description"
;; :body (reference-implementation ...))
;;
;; Typed params use (name :as type) syntax:
;; (define-primitive "+"
;; :params (&rest (args :as number))
;; :returns "number"
;; :doc "Sum all arguments.")
;;
;; Untyped params default to `any`. Typed params enable the gradual
;; type checker (types.sx) to catch mistyped primitive calls.
;;
;; The :body is optional — when provided, it gives a reference
;; implementation in SX that bootstrap compilers MAY use for testing
;; or as a fallback. Most targets will implement natively for performance.
;;
;; Modules: (define-module :name) scopes subsequent define-primitive
;; entries until the next define-module. Bootstrappers use this to
;; selectively include primitive groups.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Core — Arithmetic
;; --------------------------------------------------------------------------
(define-module :core.arithmetic)
(define-primitive "+"
:params (&rest (args :as number))
:returns "number"
:doc "Sum all arguments."
:body (reduce (fn (a b) (native-add a b)) 0 args))
(define-primitive "-"
:params ((a :as number) &rest (b :as number))
:returns "number"
:doc "Subtract. Unary: negate. Binary: a - b."
:body (if (empty? b) (native-neg a) (native-sub a (first b))))
(define-primitive "*"
:params (&rest (args :as number))
:returns "number"
:doc "Multiply all arguments."
:body (reduce (fn (a b) (native-mul a b)) 1 args))
(define-primitive "/"
:params ((a :as number) (b :as number))
:returns "number"
:doc "Divide a by b."
:body (native-div a b))
(define-primitive "mod"
:params ((a :as number) (b :as number))
:returns "number"
:doc "Modulo a % b."
:body (native-mod a b))
(define-primitive "random-int"
:params ((low :as number) (high :as number))
:returns "number"
:doc "Random integer in [low, high] inclusive."
:body (native-random-int low high))
(define-primitive "json-encode"
:params (value)
:returns "string"
:doc "Encode value as JSON string with indentation.")
(define-primitive "sqrt"
:params ((x :as number))
:returns "number"
:doc "Square root.")
(define-primitive "pow"
:params ((x :as number) (n :as number))
:returns "number"
:doc "x raised to power n.")
(define-primitive "abs"
:params ((x :as number))
:returns "number"
:doc "Absolute value.")
(define-primitive "floor"
:params ((x :as number))
:returns "number"
:doc "Floor to integer.")
(define-primitive "ceil"
:params ((x :as number))
:returns "number"
:doc "Ceiling to integer.")
(define-primitive "round"
:params ((x :as number) &rest (ndigits :as number))
:returns "number"
:doc "Round to ndigits decimal places (default 0).")
(define-primitive "min"
:params (&rest (args :as number))
:returns "number"
:doc "Minimum. Single list arg or variadic.")
(define-primitive "max"
:params (&rest (args :as number))
:returns "number"
:doc "Maximum. Single list arg or variadic.")
(define-primitive "clamp"
:params ((x :as number) (lo :as number) (hi :as number))
:returns "number"
:doc "Clamp x to range [lo, hi]."
:body (max lo (min hi x)))
(define-primitive "inc"
:params ((n :as number))
:returns "number"
:doc "Increment by 1."
:body (+ n 1))
(define-primitive "dec"
:params ((n :as number))
:returns "number"
:doc "Decrement by 1."
:body (- n 1))
;; --------------------------------------------------------------------------
;; Core — Comparison
;; --------------------------------------------------------------------------
(define-module :core.comparison)
(define-primitive "="
:params (a b)
:returns "boolean"
:doc "Deep structural equality. Alias for equal?.")
(define-primitive "!="
:params (a b)
:returns "boolean"
:doc "Inequality."
:body (not (= a b)))
(define-primitive "eq?"
:params (a b)
:returns "boolean"
:doc "Identity equality. True only if a and b are the exact same object.
For immutable atoms (numbers, strings, booleans, nil) this may or
may not match — use eqv? for reliable atom comparison.")
(define-primitive "eqv?"
:params (a b)
:returns "boolean"
:doc "Equivalent value for atoms, identity for compound objects.
Returns true for identical objects (eq?), and also for numbers,
strings, booleans, and nil with the same value. For lists, dicts,
lambdas, and components, only true if same identity.")
(define-primitive "equal?"
:params (a b)
:returns "boolean"
:doc "Deep structural equality. Recursively compares lists and dicts.
Same semantics as = but explicit Scheme name.")
(define-primitive "<"
:params ((a :as number) (b :as number))
:returns "boolean"
:doc "Less than.")
(define-primitive ">"
:params ((a :as number) (b :as number))
:returns "boolean"
:doc "Greater than.")
(define-primitive "<="
:params ((a :as number) (b :as number))
:returns "boolean"
:doc "Less than or equal.")
(define-primitive ">="
:params ((a :as number) (b :as number))
:returns "boolean"
:doc "Greater than or equal.")
;; --------------------------------------------------------------------------
;; Core — Predicates
;; --------------------------------------------------------------------------
(define-module :core.predicates)
(define-primitive "odd?"
:params ((n :as number))
:returns "boolean"
:doc "True if n is odd."
:body (= (mod n 2) 1))
(define-primitive "even?"
:params ((n :as number))
:returns "boolean"
:doc "True if n is even."
:body (= (mod n 2) 0))
(define-primitive "zero?"
:params ((n :as number))
:returns "boolean"
:doc "True if n is zero."
:body (= n 0))
(define-primitive "nil?"
:params (x)
:returns "boolean"
:doc "True if x is nil/null/None.")
(define-primitive "boolean?"
:params (x)
:returns "boolean"
:doc "True if x is a boolean (true or false). Must be checked before
number? on platforms where booleans are numeric subtypes.")
(define-primitive "number?"
:params (x)
:returns "boolean"
:doc "True if x is a number (int or float). Excludes booleans.")
(define-primitive "string?"
:params (x)
:returns "boolean"
:doc "True if x is a string.")
(define-primitive "list?"
:params (x)
:returns "boolean"
:doc "True if x is a list/array.")
(define-primitive "dict?"
:params (x)
:returns "boolean"
:doc "True if x is a dict/map.")
(define-primitive "continuation?"
:params (x)
:returns "boolean"
:doc "True if x is a captured continuation.")
(define-primitive "empty?"
:params (coll)
:returns "boolean"
:doc "True if coll is nil or has length 0.")
(define-primitive "contains?"
:params (coll key)
:returns "boolean"
:doc "True if coll contains key. Strings: substring check. Dicts: key check. Lists: membership.")
;; --------------------------------------------------------------------------
;; Core — Logic
;; --------------------------------------------------------------------------
(define-module :core.logic)
(define-primitive "not"
:params (x)
:returns "boolean"
:doc "Logical negation. Note: and/or are special forms (short-circuit).")
;; --------------------------------------------------------------------------
;; Core — Strings
;; --------------------------------------------------------------------------
(define-module :core.strings)
(define-primitive "str"
:params (&rest args)
:returns "string"
:doc "Concatenate all args as strings. nil → empty string, bool → true/false.")
(define-primitive "concat"
:params (&rest (colls :as list))
:returns "list"
:doc "Concatenate multiple lists into one. Skips nil values.")
(define-primitive "upper"
:params ((s :as string))
:returns "string"
:doc "Uppercase string.")
(define-primitive "upcase"
:params ((s :as string))
:returns "string"
:doc "Alias for upper. Uppercase string.")
(define-primitive "lower"
:params ((s :as string))
:returns "string"
:doc "Lowercase string.")
(define-primitive "downcase"
:params ((s :as string))
:returns "string"
:doc "Alias for lower. Lowercase string.")
(define-primitive "string-length"
:params ((s :as string))
:returns "number"
:doc "Length of string in characters.")
(define-primitive "char-from-code"
:params ((n :as number))
:returns "string"
:doc "Convert Unicode code point to single-character string.")
(define-primitive "substring"
:params ((s :as string) (start :as number) (end :as number))
:returns "string"
:doc "Extract substring from start (inclusive) to end (exclusive).")
(define-primitive "string-contains?"
:params ((s :as string) (needle :as string))
:returns "boolean"
:doc "True if string s contains substring needle.")
(define-primitive "trim"
:params ((s :as string))
:returns "string"
:doc "Strip leading/trailing whitespace.")
(define-primitive "split"
:params ((s :as string) &rest (sep :as string))
:returns "list"
:doc "Split string by separator (default space).")
(define-primitive "join"
:params ((sep :as string) (coll :as list))
:returns "string"
:doc "Join collection items with separator string.")
(define-primitive "replace"
:params ((s :as string) (old :as string) (new :as string))
:returns "string"
:doc "Replace all occurrences of old with new in s.")
(define-primitive "slice"
:params (coll (start :as number) &rest (end :as number))
:returns "any"
:doc "Slice a string or list from start to end (exclusive). End is optional.")
(define-primitive "index-of"
:params ((s :as string) (needle :as string) &rest (from :as number))
:returns "number"
:doc "Index of first occurrence of needle in s, or -1 if not found. Optional start index.")
(define-primitive "starts-with?"
:params ((s :as string) (prefix :as string))
:returns "boolean"
:doc "True if string s starts with prefix.")
(define-primitive "ends-with?"
:params ((s :as string) (suffix :as string))
:returns "boolean"
:doc "True if string s ends with suffix.")
;; --------------------------------------------------------------------------
;; Core — Collections
;; --------------------------------------------------------------------------
(define-module :core.collections)
(define-primitive "list"
:params (&rest args)
:returns "list"
:doc "Create a list from arguments.")
(define-primitive "dict"
:params (&rest pairs)
:returns "dict"
:doc "Create a dict from key/value pairs: (dict :a 1 :b 2).")
(define-primitive "range"
:params ((start :as number) (end :as number) &rest (step :as number))
:returns "list"
:doc "Integer range [start, end) with optional step.")
(define-primitive "get"
:params (coll key &rest default)
:returns "any"
:doc "Get value from dict by key, or list by index. Optional default.")
(define-primitive "len"
:params (coll)
:returns "number"
:doc "Length of string, list, or dict.")
(define-primitive "first"
:params ((coll :as list))
:returns "any"
:doc "First element, or nil if empty.")
(define-primitive "last"
:params ((coll :as list))
:returns "any"
:doc "Last element, or nil if empty.")
(define-primitive "rest"
:params ((coll :as list))
:returns "list"
:doc "All elements except the first.")
(define-primitive "nth"
:params ((coll :as list) (n :as number))
:returns "any"
:doc "Element at index n, or nil if out of bounds.")
(define-primitive "cons"
:params (x (coll :as list))
:returns "list"
:doc "Prepend x to coll.")
(define-primitive "append"
:params ((coll :as list) x)
:returns "list"
:doc "If x is a list, concatenate. Otherwise append x as single element.")
(define-primitive "append!"
:params ((coll :as list) x)
:returns "list"
:doc "Mutate coll by appending x in-place. Returns coll.")
(define-primitive "reverse"
:params ((coll :as list))
:returns "list"
:doc "Return coll in reverse order.")
(define-primitive "flatten"
:params ((coll :as list))
:returns "list"
:doc "Flatten one level of nesting. Nested lists become top-level elements.")
(define-primitive "chunk-every"
:params ((coll :as list) (n :as number))
:returns "list"
:doc "Split coll into sub-lists of size n.")
(define-primitive "zip-pairs"
:params ((coll :as list))
:returns "list"
:doc "Consecutive pairs: (1 2 3 4) → ((1 2) (2 3) (3 4)).")
;; --------------------------------------------------------------------------
;; Core — Dict operations
;; --------------------------------------------------------------------------
(define-module :core.dict)
(define-primitive "keys"
:params ((d :as dict))
:returns "list"
:doc "List of dict keys.")
(define-primitive "vals"
:params ((d :as dict))
:returns "list"
:doc "List of dict values.")
(define-primitive "merge"
:params (&rest (dicts :as dict))
:returns "dict"
:doc "Merge dicts left to right. Later keys win. Skips nil.")
(define-primitive "has-key?"
:params ((d :as dict) key)
:returns "boolean"
:doc "True if dict d contains key.")
(define-primitive "assoc"
:params ((d :as dict) &rest pairs)
:returns "dict"
:doc "Return new dict with key/value pairs added/overwritten.")
(define-primitive "dissoc"
:params ((d :as dict) &rest keys)
:returns "dict"
:doc "Return new dict with keys removed.")
(define-primitive "dict-set!"
:params ((d :as dict) key val)
:returns "any"
:doc "Mutate dict d by setting key to val in-place. Returns val.")
(define-primitive "into"
:params (target coll)
:returns "any"
:doc "Pour coll into target. List target: convert to list. Dict target: convert pairs to dict.")
;; --------------------------------------------------------------------------
;; Stdlib — Format
;; --------------------------------------------------------------------------
(define-module :stdlib.format)
(define-primitive "format-date"
:params ((date-str :as string) (fmt :as string))
:returns "string"
:doc "Parse ISO date string and format with strftime-style format.")
(define-primitive "format-decimal"
:params ((val :as number) &rest (places :as number))
:returns "string"
:doc "Format number with fixed decimal places (default 2).")
(define-primitive "parse-int"
:params (val &rest default)
:returns "number"
:doc "Parse string to integer with optional default on failure.")
(define-primitive "parse-datetime"
:params ((s :as string))
:returns "string"
:doc "Parse datetime string — identity passthrough (returns string or nil).")
;; --------------------------------------------------------------------------
;; Stdlib — Text
;; --------------------------------------------------------------------------
(define-module :stdlib.text)
(define-primitive "pluralize"
:params ((count :as number) &rest (forms :as string))
:returns "string"
:doc "Pluralize: (pluralize 1) → \"\", (pluralize 2) → \"s\". Or (pluralize n \"item\" \"items\").")
(define-primitive "escape"
:params ((s :as string))
:returns "string"
:doc "HTML-escape a string (&, <, >, \", ').")
(define-primitive "strip-tags"
:params ((s :as string))
:returns "string"
:doc "Remove HTML tags from string.")
;; --------------------------------------------------------------------------
;; Stdlib — Style
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; Stdlib — Debug
;; --------------------------------------------------------------------------
(define-module :stdlib.debug)
(define-primitive "assert"
:params (condition &rest message)
:returns "boolean"
:doc "Assert condition is truthy; raise error with message if not.")
;; --------------------------------------------------------------------------
;; Type introspection — platform primitives
;; --------------------------------------------------------------------------
(define-module :stdlib.types)
(define-primitive "type-of"
:params (x)
:returns "string"
:doc "Return type name: number, string, boolean, nil, symbol, keyword, list, dict, lambda, component, island, macro.")
(define-primitive "symbol-name"
:params ((sym :as symbol))
:returns "string"
:doc "Return the name string of a symbol.")
(define-primitive "keyword-name"
:params ((kw :as keyword))
:returns "string"
:doc "Return the name string of a keyword.")
(define-primitive "sx-parse"
:params ((source :as string))
:returns "list"
:doc "Parse SX source string into a list of AST expressions.")

283
shared/sx/ref/render.sx
View File

@@ -1,283 +0,0 @@
;; ==========================================================================
;; render.sx — Core rendering specification
;;
;; Shared registries and utilities used by all rendering adapters.
;; This file defines WHAT is renderable (tag registries, attribute rules)
;; and HOW arguments are parsed — but not the output format.
;;
;; Adapters:
;; adapter-html.sx — HTML string output (server)
;; adapter-sx.sx — SX wire format output (server → client)
;; adapter-dom.sx — Live DOM node output (browser)
;;
;; Each adapter imports these shared definitions and provides its own
;; render entry point (render-to-html, render-to-sx, render-to-dom).
;; ==========================================================================
;; --------------------------------------------------------------------------
;; HTML tag registry
;; --------------------------------------------------------------------------
;; Tags known to the renderer. Unknown names are treated as function calls.
;; Void elements self-close (no children). Boolean attrs emit name only.
(define HTML_TAGS
(list
;; Document
"html" "head" "body" "title" "meta" "link" "script" "style" "noscript"
;; Sections
"header" "nav" "main" "section" "article" "aside" "footer"
"h1" "h2" "h3" "h4" "h5" "h6" "hgroup"
;; Block
"div" "p" "blockquote" "pre" "figure" "figcaption" "address" "details" "summary"
;; Inline
"a" "span" "em" "strong" "small" "b" "i" "u" "s" "mark" "sub" "sup"
"abbr" "cite" "code" "time" "br" "wbr" "hr"
;; Lists
"ul" "ol" "li" "dl" "dt" "dd"
;; Tables
"table" "thead" "tbody" "tfoot" "tr" "th" "td" "caption" "colgroup" "col"
;; Forms
"form" "input" "textarea" "select" "option" "optgroup" "button" "label"
"fieldset" "legend" "output" "datalist"
;; Media
"img" "video" "audio" "source" "picture" "canvas" "iframe"
;; SVG
"svg" "math" "path" "circle" "ellipse" "rect" "line" "polyline" "polygon"
"text" "tspan" "g" "defs" "use" "clipPath" "mask" "pattern"
"linearGradient" "radialGradient" "stop" "filter"
"feGaussianBlur" "feOffset" "feBlend" "feColorMatrix" "feComposite"
"feMerge" "feMergeNode" "feTurbulence"
"feComponentTransfer" "feFuncR" "feFuncG" "feFuncB" "feFuncA"
"feDisplacementMap" "feFlood" "feImage" "feMorphology"
"feSpecularLighting" "feDiffuseLighting"
"fePointLight" "feSpotLight" "feDistantLight"
"animate" "animateTransform" "foreignObject"
;; Other
"template" "slot" "dialog" "menu"))
(define VOID_ELEMENTS
(list "area" "base" "br" "col" "embed" "hr" "img" "input"
"link" "meta" "param" "source" "track" "wbr"))
(define BOOLEAN_ATTRS
(list "async" "autofocus" "autoplay" "checked" "controls" "default"
"defer" "disabled" "formnovalidate" "hidden" "inert" "ismap"
"loop" "multiple" "muted" "nomodule" "novalidate" "open"
"playsinline" "readonly" "required" "reversed" "selected"))
;; --------------------------------------------------------------------------
;; Shared utilities
;; --------------------------------------------------------------------------
(define definition-form? :effects []
(fn ((name :as string))
(or (= name "define") (= name "defcomp") (= name "defisland")
(= name "defmacro") (= name "defstyle") (= name "defhandler")
(= name "deftype") (= name "defeffect"))))
(define parse-element-args :effects [render]
(fn ((args :as list) (env :as dict))
;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list)
(let ((attrs (dict))
(children (list)))
(reduce
(fn ((state :as dict) arg)
(let ((skip (get state "skip")))
(if skip
(assoc state "skip" false "i" (inc (get state "i")))
(if (and (= (type-of arg) "keyword")
(< (inc (get state "i")) (len args)))
(let ((val (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
(dict-set! attrs (keyword-name arg) val)
(assoc state "skip" true "i" (inc (get state "i"))))
(do
(append! children arg)
(assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false)
args)
(list attrs children))))
(define render-attrs :effects []
(fn ((attrs :as dict))
;; Render an attrs dict to an HTML attribute string.
;; Used by adapter-html.sx and adapter-sx.sx.
(join ""
(map
(fn ((key :as string))
(let ((val (dict-get attrs key)))
(cond
;; Boolean attrs
(and (contains? BOOLEAN_ATTRS key) val)
(str " " key)
(and (contains? BOOLEAN_ATTRS key) (not val))
""
;; Nil values — skip
(nil? val) ""
;; Normal attr
:else (str " " key "=\"" (escape-attr (str val)) "\""))))
(keys attrs)))))
;; --------------------------------------------------------------------------
;; Render adapter helpers
;; --------------------------------------------------------------------------
;; Shared by HTML and DOM adapters for evaluating control forms during
;; rendering. Unlike sf-cond (eval.sx) which returns a thunk for TCO,
;; eval-cond returns the unevaluated body expression so the adapter
;; can render it in its own mode (HTML string vs DOM nodes).
;; eval-cond: find matching cond branch, return unevaluated body expr.
;; Handles both scheme-style ((test body) ...) and clojure-style
;; (test body test body ...).
(define eval-cond :effects []
(fn ((clauses :as list) (env :as dict))
(if (cond-scheme? clauses)
(eval-cond-scheme clauses env)
(eval-cond-clojure clauses env))))
(define eval-cond-scheme :effects []
(fn ((clauses :as list) (env :as dict))
(if (empty? clauses)
nil
(let ((clause (first clauses))
(test (first clause))
(body (nth clause 1)))
(if (or (and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else")))
(and (= (type-of test) "keyword")
(= (keyword-name test) "else")))
body
(if (trampoline (eval-expr test env))
body
(eval-cond-scheme (rest clauses) env)))))))
(define eval-cond-clojure :effects []
(fn ((clauses :as list) (env :as dict))
(if (< (len clauses) 2)
nil
(let ((test (first clauses))
(body (nth clauses 1)))
(if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
(and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else"))))
body
(if (trampoline (eval-expr test env))
body
(eval-cond-clojure (slice clauses 2) env)))))))
;; process-bindings: evaluate let-binding pairs, return extended env.
;; bindings = ((name1 expr1) (name2 expr2) ...)
(define process-bindings :effects [mutation]
(fn ((bindings :as list) (env :as dict))
;; env-extend (not merge) — Env is not a dict subclass, so merge()
;; returns an empty dict, losing all parent scope bindings.
(let ((local (env-extend env)))
(for-each
(fn ((pair :as list))
(when (and (= (type-of pair) "list") (>= (len pair) 2))
(let ((name (if (= (type-of (first pair)) "symbol")
(symbol-name (first pair))
(str (first pair)))))
(env-set! local name (trampoline (eval-expr (nth pair 1) local))))))
bindings)
local)))
;; --------------------------------------------------------------------------
;; is-render-expr? — check if expression is a rendering form
;; --------------------------------------------------------------------------
;; Used by eval-list to dispatch rendering forms to the active adapter
;; (HTML, SX wire, or DOM) rather than evaluating them as function calls.
(define is-render-expr? :effects []
(fn (expr)
(if (or (not (= (type-of expr) "list")) (empty? expr))
false
(let ((h (first expr)))
(if (not (= (type-of h) "symbol"))
false
(let ((n (symbol-name h)))
(or (= n "<>")
(= n "raw!")
(starts-with? n "~")
(starts-with? n "html:")
(contains? HTML_TAGS n)
(and (> (index-of n "-") 0)
(> (len expr) 1)
(= (type-of (nth expr 1)) "keyword")))))))))
;; --------------------------------------------------------------------------
;; Spread — attribute injection from children into parent elements
;; --------------------------------------------------------------------------
;;
;; A spread value is a dict of attributes that, when returned as a child
;; of an HTML element, merges its attrs onto the parent element.
;; This enables components to inject classes/styles/data-attrs onto their
;; parent without the parent knowing about the specific attrs.
;;
;; merge-spread-attrs: merge a spread's attrs into an element's attrs dict.
;; Class values are joined (space-separated); others overwrite.
;; Mutates the target attrs dict in place.
(define merge-spread-attrs :effects [mutation]
(fn ((target :as dict) (spread-dict :as dict))
(for-each
(fn ((key :as string))
(let ((val (dict-get spread-dict key)))
(if (= key "class")
;; Class: join existing + new with space
(let ((existing (dict-get target "class")))
(dict-set! target "class"
(if (and existing (not (= existing "")))
(str existing " " val)
val)))
;; Style: join with semicolons
(if (= key "style")
(let ((existing (dict-get target "style")))
(dict-set! target "style"
(if (and existing (not (= existing "")))
(str existing ";" val)
val)))
;; Everything else: overwrite
(dict-set! target key val)))))
(keys spread-dict))))
;; --------------------------------------------------------------------------
;; Platform interface (shared across adapters)
;; --------------------------------------------------------------------------
;;
;; HTML/attribute escaping (used by HTML and SX wire adapters):
;; (escape-html s) → HTML-escaped string
;; (escape-attr s) → attribute-value-escaped string
;; (raw-html-content r) → unwrap RawHTML marker to string
;;
;; Spread (render-time attribute injection):
;; (make-spread attrs) → Spread value
;; (spread? x) → boolean
;; (spread-attrs s) → dict
;;
;; Render-time accumulators:
;; (collect! bucket value) → void
;; (collected bucket) → list
;; (clear-collected! bucket) → void
;;
;; Scoped effects (scope/provide/context/emit!):
;; (scope-push! name val) → void (general form)
;; (scope-pop! name) → void (general form)
;; (provide-push! name val) → alias for scope-push!
;; (provide-pop! name) → alias for scope-pop!
;; (context name &rest def) → value from nearest scope
;; (emit! name value) → void (append to scope accumulator)
;; (emitted name) → list of emitted values
;;
;; From parser.sx:
;; (sx-serialize val) → SX source string (aliased as serialize above)
;; --------------------------------------------------------------------------

444
shared/sx/ref/special-forms.sx
View File

@@ -1,444 +0,0 @@
;; ==========================================================================
;; special-forms.sx — Specification of all SX special forms
;;
;; Special forms are syntactic constructs whose arguments are NOT evaluated
;; before dispatch. Each form has its own evaluation rules — unlike primitives,
;; which receive pre-evaluated values.
;;
;; This file is a SPECIFICATION, not executable code. Bootstrap compilers
;; consume these declarations but implement special forms natively.
;;
;; Format:
;; (define-special-form "name"
;; :syntax (name arg1 arg2 ...)
;; :doc "description"
;; :tail-position "which subexpressions are in tail position"
;; :example "(name ...)")
;;
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Control flow
;; --------------------------------------------------------------------------
(define-special-form "if"
:syntax (if condition then-expr else-expr)
:doc "If condition is truthy, evaluate then-expr; otherwise evaluate else-expr.
Both branches are in tail position. The else branch is optional and
defaults to nil."
:tail-position "then-expr, else-expr"
:example "(if (> x 10) \"big\" \"small\")")
(define-special-form "when"
:syntax (when condition body ...)
:doc "If condition is truthy, evaluate all body expressions sequentially.
Returns the value of the last body expression, or nil if condition
is falsy. Only the last body expression is in tail position."
:tail-position "last body expression"
:example "(when (logged-in? user)
(render-dashboard user))")
(define-special-form "cond"
:syntax (cond test1 result1 test2 result2 ... :else default)
:doc "Multi-way conditional. Tests are evaluated in order; the result
paired with the first truthy test is returned. The :else keyword
(or the symbol else) matches unconditionally. Supports both
Clojure-style flat pairs and Scheme-style nested pairs:
Clojure: (cond test1 result1 test2 result2 :else default)
Scheme: (cond (test1 result1) (test2 result2) (else default))"
:tail-position "all result expressions"
:example "(cond
(= status \"active\") (render-active item)
(= status \"draft\") (render-draft item)
:else (render-unknown item))")
(define-special-form "case"
:syntax (case expr val1 result1 val2 result2 ... :else default)
:doc "Match expr against values using equality. Like cond but tests
a single expression against multiple values. The :else keyword
matches if no values match."
:tail-position "all result expressions"
:example "(case (get request \"method\")
\"GET\" (handle-get request)
\"POST\" (handle-post request)
:else (method-not-allowed))")
(define-special-form "and"
:syntax (and expr ...)
:doc "Short-circuit logical AND. Evaluates expressions left to right.
Returns the first falsy value, or the last value if all are truthy.
Returns true if given no arguments."
:tail-position "last expression"
:example "(and (valid? input) (authorized? user) (process input))")
(define-special-form "or"
:syntax (or expr ...)
:doc "Short-circuit logical OR. Evaluates expressions left to right.
Returns the first truthy value, or the last value if all are falsy.
Returns false if given no arguments."
:tail-position "last expression"
:example "(or (get cache key) (fetch-from-db key) \"default\")")
;; --------------------------------------------------------------------------
;; Binding
;; --------------------------------------------------------------------------
(define-special-form "let"
:syntax (let bindings body ...)
:doc "Create local bindings and evaluate body in the extended environment.
Bindings can be Scheme-style ((name val) ...) or Clojure-style
(name val name val ...). Each binding can see previous bindings.
Only the last body expression is in tail position.
Named let: (let name ((x init) ...) body) creates a loop. The name
is bound to a function that takes the same params and recurses with
tail-call optimization."
:tail-position "last body expression; recursive call in named let"
:example ";; Basic let
(let ((x 10) (y 20))
(+ x y))
;; Clojure-style
(let (x 10 y 20)
(+ x y))
;; Named let (loop)
(let loop ((i 0) (acc 0))
(if (= i 100)
acc
(loop (+ i 1) (+ acc i))))")
(define-special-form "let*"
:syntax (let* bindings body ...)
:doc "Alias for let. In SX, let is already sequential (each binding
sees previous ones), so let* is identical to let."
:tail-position "last body expression"
:example "(let* ((x 10) (y (* x 2)))
(+ x y)) ;; → 30")
(define-special-form "letrec"
:syntax (letrec bindings body ...)
:doc "Mutually recursive local bindings. All names are bound to nil first,
then all values are evaluated (so they can reference each other),
then lambda closures are patched to include the final bindings.
Used for defining mutually recursive local functions."
:tail-position "last body expression"
:example "(letrec ((even? (fn (n) (if (= n 0) true (odd? (- n 1)))))
(odd? (fn (n) (if (= n 0) false (even? (- n 1))))))
(even? 10)) ;; → true")
(define-special-form "define"
:syntax (define name value)
:doc "Bind name to value in the current environment. If value is a lambda
and has no name, the lambda's name is set to the symbol name.
Returns the value."
:tail-position "none (value is eagerly evaluated)"
:example "(define greeting \"hello\")
(define double (fn (x) (* x 2)))")
(define-special-form "set!"
:syntax (set! name value)
:doc "Mutate an existing binding. The name must already be bound in the
current environment. Returns the new value."
:tail-position "none (value is eagerly evaluated)"
:example "(let (count 0)
(set! count (+ count 1)))")
;; --------------------------------------------------------------------------
;; Functions and components
;; --------------------------------------------------------------------------
(define-special-form "lambda"
:syntax (lambda params body)
:doc "Create a function. Params is a list of parameter names. Body is
a single expression (the return value). The lambda captures the
current environment as its closure."
:tail-position "body"
:example "(lambda (x y) (+ x y))")
(define-special-form "fn"
:syntax (fn params body)
:doc "Alias for lambda."
:tail-position "body"
:example "(fn (x) (* x x))")
(define-special-form "defcomp"
:syntax (defcomp ~name (&key param1 param2 &rest children) body)
:doc "Define a component. Components are called with keyword arguments
and optional positional children. The &key marker introduces
keyword parameters. The &rest (or &children) marker captures
remaining positional arguments as a list.
Component names conventionally start with ~ to distinguish them
from HTML elements. Components are evaluated with a merged
environment: closure + caller-env + bound-params."
:tail-position "body"
:example "(defcomp ~card (&key title subtitle &rest children)
(div :class \"card\"
(h2 title)
(when subtitle (p subtitle))
children))")
(define-special-form "defisland"
:syntax (defisland ~name (&key param1 param2 &rest children) body)
:doc "Define a reactive island. Islands have the same calling convention
as components (defcomp) but create a reactive boundary. Inside an
island, signals are tracked — deref subscribes DOM nodes to signals,
and signal changes update only the affected nodes.
On the server, islands render as static HTML wrapped in a
data-sx-island container with serialized initial state. On the
client, islands hydrate into reactive contexts."
:tail-position "body"
:example "(defisland ~counter (&key initial)
(let ((count (signal (or initial 0))))
(div :class \"counter\"
(span (deref count))
(button :on-click (fn (e) (swap! count inc)) \"+\"))))")
(define-special-form "defmacro"
:syntax (defmacro name (params ...) body)
:doc "Define a macro. Macros receive their arguments unevaluated (as raw
AST) and return a new expression that is then evaluated. The
returned expression replaces the macro call. Use quasiquote for
template construction."
:tail-position "none (expansion is evaluated separately)"
:example "(defmacro unless (condition &rest body)
`(when (not ~condition) ~@body))")
(define-special-form "deftype"
:syntax (deftype name body)
:doc "Define a named type. The name can be a simple symbol for type aliases
and records, or a list (name param ...) for parameterized types.
Body is a type expression: a symbol (alias), (union t1 t2 ...) for
union types, or {:field1 type1 :field2 type2} for record types.
Type definitions are metadata for the type checker with no runtime cost."
:tail-position "none"
:example "(deftype price number)
(deftype card-props {:title string :price number})
(deftype (maybe a) (union a nil))")
(define-special-form "defeffect"
:syntax (defeffect name)
:doc "Declare a named effect. Effects annotate functions and components
to track side effects. A pure function (:effects [pure]) cannot
call IO functions. Unannotated functions are assumed to have all
effects. Effect checking is gradual — annotations opt in."
:tail-position "none"
:example "(defeffect io)
(defeffect async)
(define add :effects [pure] (fn (a b) (+ a b)))")
;; --------------------------------------------------------------------------
;; Sequencing and threading
;; --------------------------------------------------------------------------
(define-special-form "begin"
:syntax (begin expr ...)
:doc "Evaluate expressions sequentially. Returns the value of the last
expression. Used when multiple side-effecting expressions need
to be grouped."
:tail-position "last expression"
:example "(begin
(log \"starting\")
(process data)
(log \"done\"))")
(define-special-form "do"
:syntax (do expr ...)
:doc "Alias for begin."
:tail-position "last expression"
:example "(do (set! x 1) (set! y 2) (+ x y))")
(define-special-form "->"
:syntax (-> value form1 form2 ...)
:doc "Thread-first macro. Threads value through a series of function calls,
inserting it as the first argument of each form. Nested lists are
treated as function calls; bare symbols become unary calls."
:tail-position "last form"
:example "(-> user
(get \"name\")
upper
(str \" says hello\"))
;; Expands to: (str (upper (get user \"name\")) \" says hello\")")
;; --------------------------------------------------------------------------
;; Quoting
;; --------------------------------------------------------------------------
(define-special-form "quote"
:syntax (quote expr)
:doc "Return expr as data, without evaluating it. Symbols remain symbols,
lists remain lists. The reader shorthand is the ' prefix."
:tail-position "none (not evaluated)"
:example "'(+ 1 2) ;; → the list (+ 1 2), not the number 3")
(define-special-form "quasiquote"
:syntax (quasiquote expr)
:doc "Template construction. Like quote, but allows unquoting with ~ and
splicing with ~@. The reader shorthand is the ` prefix.
`(a ~b ~@c)
Quotes everything except: ~expr evaluates expr and inserts the
result; ~@expr evaluates to a list and splices its elements."
:tail-position "none (template is constructed, not evaluated)"
:example "`(div :class \"card\" ~title ~@children)")
;; --------------------------------------------------------------------------
;; Continuations
;; --------------------------------------------------------------------------
(define-special-form "reset"
:syntax (reset body)
:doc "Establish a continuation delimiter. Evaluates body normally unless
a shift is encountered, in which case the continuation (the rest
of the computation up to this reset) is captured and passed to
the shift's body. Without shift, reset is a no-op wrapper."
:tail-position "body"
:example "(reset (+ 1 (shift k (k 10)))) ;; → 11")
(define-special-form "shift"
:syntax (shift k body)
:doc "Capture the continuation to the nearest reset as k, then evaluate
body with k bound. If k is never called, the value of body is
returned from the reset (abort). If k is called with a value,
the reset body is re-evaluated with shift returning that value.
k can be called multiple times."
:tail-position "body"
:example ";; Abort: shift body becomes the reset result
(reset (+ 1 (shift k 42))) ;; → 42
;; Resume: k re-enters the computation
(reset (+ 1 (shift k (k 10)))) ;; → 11
;; Multiple invocations
(reset (* 2 (shift k (+ (k 1) (k 10))))) ;; → 24")
;; --------------------------------------------------------------------------
;; Guards
;; --------------------------------------------------------------------------
(define-special-form "dynamic-wind"
:syntax (dynamic-wind before-thunk body-thunk after-thunk)
:doc "Entry/exit guards. All three arguments are zero-argument functions
(thunks). before-thunk is called on entry, body-thunk is called
for the result, and after-thunk is always called on exit (even on
error). The wind stack is maintained so that when continuations
jump across dynamic-wind boundaries, the correct before/after
thunks fire."
:tail-position "none (all thunks are eagerly called)"
:example "(dynamic-wind
(fn () (log \"entering\"))
(fn () (do-work))
(fn () (log \"exiting\")))")
;; --------------------------------------------------------------------------
;; Higher-order forms
;;
;; These are syntactic forms (not primitives) because the evaluator
;; handles them directly for performance — avoiding the overhead of
;; constructing argument lists and doing generic dispatch. They could
;; be implemented as primitives but are special-cased in eval-list.
;; --------------------------------------------------------------------------
(define-special-form "map"
:syntax (map fn coll)
:doc "Apply fn to each element of coll, returning a list of results."
:tail-position "none"
:example "(map (fn (x) (* x x)) (list 1 2 3 4)) ;; → (1 4 9 16)")
(define-special-form "map-indexed"
:syntax (map-indexed fn coll)
:doc "Like map, but fn receives two arguments: (index element)."
:tail-position "none"
:example "(map-indexed (fn (i x) (str i \": \" x)) (list \"a\" \"b\" \"c\"))")
(define-special-form "filter"
:syntax (filter fn coll)
:doc "Return elements of coll for which fn returns truthy."
:tail-position "none"
:example "(filter (fn (x) (> x 3)) (list 1 5 2 8 3)) ;; → (5 8)")
(define-special-form "reduce"
:syntax (reduce fn init coll)
:doc "Reduce coll to a single value. fn receives (accumulator element)
and returns the new accumulator. init is the initial value."
:tail-position "none"
:example "(reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)) ;; → 10")
(define-special-form "some"
:syntax (some fn coll)
:doc "Return the first truthy result of applying fn to elements of coll,
or nil if none match. Short-circuits on first truthy result."
:tail-position "none"
:example "(some (fn (x) (> x 3)) (list 1 2 5 3)) ;; → true")
(define-special-form "every?"
:syntax (every? fn coll)
:doc "Return true if fn returns truthy for every element of coll.
Short-circuits on first falsy result."
:tail-position "none"
:example "(every? (fn (x) (> x 0)) (list 1 2 3)) ;; → true")
(define-special-form "for-each"
:syntax (for-each fn coll)
:doc "Apply fn to each element of coll for side effects. Returns nil."
:tail-position "none"
:example "(for-each (fn (x) (log x)) (list 1 2 3))")
;; --------------------------------------------------------------------------
;; Definition forms (domain-specific)
;;
;; These define named entities in the environment. They are special forms
;; because their arguments have domain-specific structure that the
;; evaluator parses directly.
;; --------------------------------------------------------------------------
(define-special-form "defstyle"
:syntax (defstyle name expr)
:doc "Define a named style value. Evaluates expr and binds the result
to name in the environment. The value is typically a class string
or a function that returns class strings."
:tail-position "none"
:example "(defstyle card-style \"rounded-lg shadow-md p-4 bg-white\")")
(define-special-form "defhandler"
:syntax (defhandler name (&key params ...) body)
:doc "Define an event handler function. Used by the SxEngine for
client-side event handling."
:tail-position "body"
:example "(defhandler toggle-menu (&key target)
(toggle-class target \"hidden\"))")
(define-special-form "defpage"
:syntax (defpage name &key route method content ...)
:doc "Define a page route. Declares the URL pattern, HTTP method, and
content component for server-side page routing."
:tail-position "none"
:example "(defpage dashboard-page
:route \"/dashboard\"
:content (~dashboard-content))")
(define-special-form "defquery"
:syntax (defquery name (&key params ...) body)
:doc "Define a named query for data fetching. Used by the resolver
system to declare data dependencies."
:tail-position "body"
:example "(defquery user-profile (&key user-id)
(fetch-user user-id))")
(define-special-form "defaction"
:syntax (defaction name (&key params ...) body)
:doc "Define a named action for mutations. Like defquery but for
write operations."
:tail-position "body"
:example "(defaction update-profile (&key user-id name email)
(save-user user-id name email))")

917
shared/sx/ref/types.sx
View File

@@ -1,917 +0,0 @@
;; ==========================================================================
;; types.sx — Gradual type system for SX
;;
;; Registration-time type checking: zero runtime cost.
;; Annotations are optional — unannotated code defaults to `any`.
;;
;; Depends on: eval.sx (type-of, component accessors, env ops)
;; primitives.sx, boundary.sx (return type declarations)
;;
;; Platform interface (from eval.sx, already provided):
;; (type-of x) → type string
;; (symbol-name s) → string
;; (keyword-name k) → string
;; (component-body c) → AST
;; (component-params c) → list of param name strings
;; (component-has-children c) → boolean
;; (env-get env k) → value or nil
;;
;; New platform functions for types.sx:
;; (component-param-types c) → dict {param-name → type} or nil
;; (component-set-param-types! c d) → store param types on component
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Type representation
;; --------------------------------------------------------------------------
;; Types are plain SX values:
;; - Strings for base types: "number", "string", "boolean", "nil",
;; "symbol", "keyword", "element", "any", "never"
;; - Nullable shorthand: "string?", "number?", "dict?", "boolean?"
;; → equivalent to (or string nil) etc.
;; - Lists for compound types:
;; (or t1 t2 ...) — union
;; (list-of t) — homogeneous list
;; (dict-of tk tv) — typed dict
;; (-> t1 t2 ... treturn) — function type (last is return)
;; Base type names
(define base-types
(list "number" "string" "boolean" "nil" "symbol" "keyword"
"element" "any" "never" "list" "dict"
"lambda" "component" "island" "macro" "signal"))
;; --------------------------------------------------------------------------
;; 2. Type predicates
;; --------------------------------------------------------------------------
(define type-any?
(fn (t) (= t "any")))
(define type-never?
(fn (t) (= t "never")))
(define type-nullable?
(fn (t)
;; A type is nullable if it's "any", "nil", a "?" shorthand, or
;; a union containing "nil".
(if (= t "any") true
(if (= t "nil") true
(if (and (= (type-of t) "string") (ends-with? t "?")) true
(if (and (= (type-of t) "list")
(not (empty? t))
(= (first t) "or"))
(contains? (rest t) "nil")
false))))))
(define nullable-base
(fn (t)
;; Strip "?" from nullable shorthand: "string?" → "string"
(if (and (= (type-of t) "string")
(ends-with? t "?")
(not (= t "?")))
(slice t 0 (- (string-length t) 1))
t)))
;; --------------------------------------------------------------------------
;; 3. Subtype checking
;; --------------------------------------------------------------------------
;; subtype?(a, b) — is type `a` assignable to type `b`?
(define subtype?
(fn (a b)
;; any accepts everything
(if (type-any? b) true
;; never is subtype of everything
(if (type-never? a) true
;; any is not a subtype of a specific type
(if (type-any? a) false
;; identical types
(if (= a b) true
;; nil is subtype of nullable types
(if (= a "nil")
(type-nullable? b)
;; nullable shorthand: "string?" = (or string nil)
(if (and (= (type-of b) "string") (ends-with? b "?"))
(let ((base (nullable-base b)))
(or (= a base) (= a "nil")))
;; a is a union: (or t1 t2 ...) <: b if ALL members <: b
;; Must check before b-union — (or A B) <: (or A B C) needs
;; each member of a checked against the full union b.
(if (and (= (type-of a) "list")
(not (empty? a))
(= (first a) "or"))
(every? (fn (member) (subtype? member b)) (rest a))
;; union: a <: (or t1 t2 ...) if a <: any member
(if (and (= (type-of b) "list")
(not (empty? b))
(= (first b) "or"))
(some (fn (member) (subtype? a member)) (rest b))
;; list-of covariance
(if (and (= (type-of a) "list") (= (type-of b) "list")
(= (len a) 2) (= (len b) 2)
(= (first a) "list-of") (= (first b) "list-of"))
(subtype? (nth a 1) (nth b 1))
;; "list" <: (list-of any)
(if (and (= a "list")
(= (type-of b) "list")
(= (len b) 2)
(= (first b) "list-of"))
(type-any? (nth b 1))
;; (list-of t) <: "list"
(if (and (= (type-of a) "list")
(= (len a) 2)
(= (first a) "list-of")
(= b "list"))
true
;; "element" is subtype of "string?" (rendered HTML)
false)))))))))))))
;; --------------------------------------------------------------------------
;; 4. Type union
;; --------------------------------------------------------------------------
(define type-union
(fn (a b)
;; Compute the smallest type that encompasses both a and b.
(if (= a b) a
(if (type-any? a) "any"
(if (type-any? b) "any"
(if (type-never? a) b
(if (type-never? b) a
(if (subtype? a b) b
(if (subtype? b a) a
;; neither is subtype — create a union
(if (= a "nil")
;; nil + string → string?
(if (and (= (type-of b) "string")
(not (ends-with? b "?")))
(str b "?")
(list "or" a b))
(if (= b "nil")
(if (and (= (type-of a) "string")
(not (ends-with? a "?")))
(str a "?")
(list "or" a b))
(list "or" a b))))))))))))
;; --------------------------------------------------------------------------
;; 5. Type narrowing
;; --------------------------------------------------------------------------
(define narrow-type
(fn (t (predicate-name :as string))
;; Narrow type based on a predicate test in a truthy branch.
;; (if (nil? x) ..then.. ..else..) → in else, x excludes nil.
;; Returns (narrowed-then narrowed-else).
(if (= predicate-name "nil?")
(list "nil" (narrow-exclude-nil t))
(if (= predicate-name "string?")
(list "string" (narrow-exclude t "string"))
(if (= predicate-name "number?")
(list "number" (narrow-exclude t "number"))
(if (= predicate-name "list?")
(list "list" (narrow-exclude t "list"))
(if (= predicate-name "dict?")
(list "dict" (narrow-exclude t "dict"))
(if (= predicate-name "boolean?")
(list "boolean" (narrow-exclude t "boolean"))
;; Unknown predicate — no narrowing
(list t t)))))))))
(define narrow-exclude-nil
(fn (t)
;; Remove nil from a type.
(if (= t "nil") "never"
(if (= t "any") "any" ;; can't narrow any
(if (and (= (type-of t) "string") (ends-with? t "?"))
(nullable-base t)
(if (and (= (type-of t) "list")
(not (empty? t))
(= (first t) "or"))
(let ((members (filter (fn (m) (not (= m "nil"))) (rest t))))
(if (= (len members) 1) (first members)
(if (empty? members) "never"
(cons "or" members))))
t))))))
(define narrow-exclude
(fn (t excluded)
;; Remove a specific type from a union.
(if (= t excluded) "never"
(if (= t "any") "any"
(if (and (= (type-of t) "list")
(not (empty? t))
(= (first t) "or"))
(let ((members (filter (fn (m) (not (= m excluded))) (rest t))))
(if (= (len members) 1) (first members)
(if (empty? members) "never"
(cons "or" members))))
t)))))
;; --------------------------------------------------------------------------
;; 6. Type inference
;; --------------------------------------------------------------------------
;; infer-type walks an AST node and returns its inferred type.
;; type-env is a dict mapping variable names → types.
(define infer-type
(fn (node (type-env :as dict) (prim-types :as dict) type-registry)
(let ((kind (type-of node)))
(if (= kind "number") "number"
(if (= kind "string") "string"
(if (= kind "boolean") "boolean"
(if (nil? node) "nil"
(if (= kind "keyword") "keyword"
(if (= kind "symbol")
(let ((name (symbol-name node)))
;; Look up in type env
(if (has-key? type-env name)
(get type-env name)
;; Builtins
(if (= name "true") "boolean"
(if (= name "false") "boolean"
(if (= name "nil") "nil"
;; Check primitive return types
(if (has-key? prim-types name)
(get prim-types name)
"any"))))))
(if (= kind "dict") "dict"
(if (= kind "list")
(infer-list-type node type-env prim-types type-registry)
"any")))))))))))
(define infer-list-type
(fn (node (type-env :as dict) (prim-types :as dict) type-registry)
;; Infer type of a list expression (function call, special form, etc.)
(if (empty? node) "list"
(let ((head (first node))
(args (rest node)))
(if (not (= (type-of head) "symbol"))
"any" ;; complex head — can't infer
(let ((name (symbol-name head)))
;; Special forms
(if (= name "if")
(infer-if-type args type-env prim-types type-registry)
(if (= name "when")
(if (>= (len args) 2)
(type-union (infer-type (last args) type-env prim-types type-registry) "nil")
"nil")
(if (or (= name "cond") (= name "case"))
"any" ;; complex — could be refined later
(if (= name "let")
(infer-let-type args type-env prim-types type-registry)
(if (or (= name "do") (= name "begin"))
(if (empty? args) "nil"
(infer-type (last args) type-env prim-types type-registry))
(if (or (= name "lambda") (= name "fn"))
"lambda"
(if (= name "and")
(if (empty? args) "boolean"
(infer-type (last args) type-env prim-types type-registry))
(if (= name "or")
(if (empty? args) "boolean"
;; or returns first truthy — union of all args
(reduce type-union "never"
(map (fn (a) (infer-type a type-env prim-types type-registry)) args)))
(if (= name "map")
;; map returns a list
(if (>= (len args) 2)
(let ((fn-type (infer-type (first args) type-env prim-types type-registry)))
;; If the fn's return type is known, produce (list-of return-type)
(if (and (= (type-of fn-type) "list")
(= (first fn-type) "->"))
(list "list-of" (last fn-type))
"list"))
"list")
(if (= name "filter")
;; filter preserves element type
(if (>= (len args) 2)
(infer-type (nth args 1) type-env prim-types type-registry)
"list")
(if (= name "reduce")
;; reduce returns the accumulator type — too complex to infer
"any"
(if (= name "list")
"list"
(if (= name "dict")
"dict"
(if (= name "quote")
"any"
(if (= name "str")
"string"
(if (= name "not")
"boolean"
(if (= name "get")
;; get — resolve record field type from type registry
(if (and (>= (len args) 2) (not (nil? type-registry)))
(let ((dict-type (infer-type (first args) type-env prim-types type-registry))
(key-arg (nth args 1))
(key-name (cond
(= (type-of key-arg) "keyword") (keyword-name key-arg)
(= (type-of key-arg) "string") key-arg
:else nil)))
(if (and key-name
(= (type-of dict-type) "string")
(has-key? type-registry dict-type))
(let ((resolved (resolve-type dict-type type-registry)))
(if (and (= (type-of resolved) "dict")
(has-key? resolved key-name))
(get resolved key-name)
"any"))
"any"))
"any")
(if (starts-with? name "~")
"element" ;; component call
;; Regular function call: look up return type
(if (has-key? prim-types name)
(get prim-types name)
"any")))))))))))))))))))))))))
(define infer-if-type
(fn ((args :as list) (type-env :as dict) (prim-types :as dict) type-registry)
;; (if test then else?) → union of then and else types
(if (< (len args) 2) "nil"
(let ((then-type (infer-type (nth args 1) type-env prim-types type-registry)))
(if (>= (len args) 3)
(type-union then-type (infer-type (nth args 2) type-env prim-types type-registry))
(type-union then-type "nil"))))))
(define infer-let-type
(fn ((args :as list) (type-env :as dict) (prim-types :as dict) type-registry)
;; (let ((x expr) ...) body) → type of body in extended type-env
(if (< (len args) 2) "nil"
(let ((bindings (first args))
(body (last args))
(extended (merge type-env (dict))))
;; Add binding types
(for-each
(fn (binding)
(when (and (= (type-of binding) "list") (>= (len binding) 2))
(let ((name (if (= (type-of (first binding)) "symbol")
(symbol-name (first binding))
(str (first binding))))
(val-type (infer-type (nth binding 1) extended prim-types type-registry)))
(dict-set! extended name val-type))))
bindings)
(infer-type body extended prim-types type-registry)))))
;; --------------------------------------------------------------------------
;; 7. Diagnostic types
;; --------------------------------------------------------------------------
;; Diagnostics are dicts:
;; {:level "error"|"warning"|"info"
;; :message "human-readable explanation"
;; :component "~name" (or nil for top-level)
;; :expr <the offending AST node>}
(define make-diagnostic
(fn ((level :as string) (message :as string) component expr)
{:level level
:message message
:component component
:expr expr}))
;; --------------------------------------------------------------------------
;; 8. Call-site checking
;; --------------------------------------------------------------------------
(define check-primitive-call
(fn ((name :as string) (args :as list) (type-env :as dict) (prim-types :as dict) prim-param-types (comp-name :as string) type-registry)
;; Check a primitive call site against declared param types.
;; prim-param-types is a dict: {prim-name → {:positional [...] :rest-type type-or-nil}}
;; Each positional entry is a list (name type-or-nil).
;; Returns list of diagnostics.
(let ((diagnostics (list)))
(when (and (not (nil? prim-param-types))
(has-key? prim-param-types name))
(let ((sig (get prim-param-types name))
(positional (get sig "positional"))
(rest-type (get sig "rest-type")))
;; Check each positional arg
(for-each
(fn (idx)
(when (< idx (len args))
(if (< idx (len positional))
;; Positional param — check against declared type
(let ((param-info (nth positional idx))
(arg-expr (nth args idx)))
(let ((expected-type (nth param-info 1)))
(when (not (nil? expected-type))
(let ((actual (infer-type arg-expr type-env prim-types type-registry)))
(when (and (not (type-any? expected-type))
(not (type-any? actual))
(not (subtype-resolved? actual expected-type type-registry)))
(append! diagnostics
(make-diagnostic "error"
(str "Argument " (+ idx 1) " of `" name
"` expects " expected-type ", got " actual)
comp-name arg-expr)))))))
;; Rest param — check against rest-type
(when (not (nil? rest-type))
(let ((arg-expr (nth args idx))
(actual (infer-type arg-expr type-env prim-types type-registry)))
(when (and (not (type-any? rest-type))
(not (type-any? actual))
(not (subtype-resolved? actual rest-type type-registry)))
(append! diagnostics
(make-diagnostic "error"
(str "Argument " (+ idx 1) " of `" name
"` expects " rest-type ", got " actual)
comp-name arg-expr))))))))
(range 0 (len args) 1))))
diagnostics)))
(define check-component-call
(fn ((comp-name :as string) (comp :as component) (call-args :as list) (type-env :as dict) (prim-types :as dict) type-registry)
;; Check a component call site against its declared param types.
;; comp is the component value, call-args is the list of args
;; from the call site (after the component name).
(let ((diagnostics (list))
(param-types (component-param-types comp))
(params (component-params comp)))
(when (and (not (nil? param-types))
(not (empty? (keys param-types))))
;; Parse keyword args from call site
(let ((i 0)
(provided-keys (list)))
(for-each
(fn (idx)
(when (< idx (len call-args))
(let ((arg (nth call-args idx)))
(when (= (type-of arg) "keyword")
(let ((key-name (keyword-name arg)))
(append! provided-keys key-name)
(when (< (+ idx 1) (len call-args))
(let ((val-expr (nth call-args (+ idx 1))))
;; Check type of value against declared param type
(when (has-key? param-types key-name)
(let ((expected (get param-types key-name))
(actual (infer-type val-expr type-env prim-types type-registry)))
(when (and (not (type-any? expected))
(not (type-any? actual))
(not (subtype-resolved? actual expected type-registry)))
(append! diagnostics
(make-diagnostic "error"
(str "Keyword :" key-name " of " comp-name
" expects " expected ", got " actual)
comp-name val-expr))))))))))))
(range 0 (len call-args) 1))
;; Check for missing required params (those with declared types)
(for-each
(fn (param-name)
(when (and (has-key? param-types param-name)
(not (contains? provided-keys param-name))
(not (type-nullable? (get param-types param-name))))
(append! diagnostics
(make-diagnostic "warning"
(str "Required param :" param-name " of " comp-name " not provided")
comp-name nil))))
params)
;; Check for unknown kwargs
(for-each
(fn (key)
(when (not (contains? params key))
(append! diagnostics
(make-diagnostic "warning"
(str "Unknown keyword :" key " passed to " comp-name)
comp-name nil))))
provided-keys)))
diagnostics)))
;; --------------------------------------------------------------------------
;; 9. AST walker — check a component body
;; --------------------------------------------------------------------------
(define check-body-walk
(fn (node (comp-name :as string) (type-env :as dict) (prim-types :as dict) prim-param-types env (diagnostics :as list) type-registry effect-annotations)
;; Recursively walk an AST and collect diagnostics.
;; prim-param-types: dict of {name → {:positional [...] :rest-type t}} or nil
;; type-registry: dict of {type-name → type-def} or nil
;; effect-annotations: dict of {fn-name → effect-list} or nil
(let ((kind (type-of node)))
(when (= kind "list")
(when (not (empty? node))
(let ((head (first node))
(args (rest node)))
;; Check calls when head is a symbol
(when (= (type-of head) "symbol")
(let ((name (symbol-name head)))
;; Component call
(when (starts-with? name "~")
(let ((comp-val (env-get env name)))
(when (= (type-of comp-val) "component")
(for-each
(fn (d) (append! diagnostics d))
(check-component-call name comp-val args
type-env prim-types type-registry))))
;; Effect check for component calls
(when (not (nil? effect-annotations))
(let ((caller-effects (get-effects comp-name effect-annotations)))
(for-each
(fn (d) (append! diagnostics d))
(check-effect-call name caller-effects effect-annotations comp-name)))))
;; Primitive call — check param types
(when (and (not (starts-with? name "~"))
(not (nil? prim-param-types))
(has-key? prim-param-types name))
(for-each
(fn (d) (append! diagnostics d))
(check-primitive-call name args type-env prim-types
prim-param-types comp-name type-registry)))
;; Effect check for function calls
(when (and (not (starts-with? name "~"))
(not (nil? effect-annotations)))
(let ((caller-effects (get-effects comp-name effect-annotations)))
(for-each
(fn (d) (append! diagnostics d))
(check-effect-call name caller-effects effect-annotations comp-name))))
;; Recurse into let with extended type env
(when (or (= name "let") (= name "let*"))
(when (>= (len args) 2)
(let ((bindings (first args))
(body-exprs (rest args))
(extended (merge type-env (dict))))
(for-each
(fn (binding)
(when (and (= (type-of binding) "list")
(>= (len binding) 2))
(let ((bname (if (= (type-of (first binding)) "symbol")
(symbol-name (first binding))
(str (first binding))))
(val-type (infer-type (nth binding 1) extended prim-types type-registry)))
(dict-set! extended bname val-type))))
bindings)
(for-each
(fn (body)
(check-body-walk body comp-name extended prim-types prim-param-types env diagnostics type-registry effect-annotations))
body-exprs))))
;; Recurse into define with type binding
(when (= name "define")
(when (>= (len args) 2)
(let ((def-name (if (= (type-of (first args)) "symbol")
(symbol-name (first args))
nil))
(def-val (nth args 1)))
(when def-name
(dict-set! type-env def-name
(infer-type def-val type-env prim-types type-registry)))
(check-body-walk def-val comp-name type-env prim-types prim-param-types env diagnostics type-registry effect-annotations))))))
;; Recurse into all child expressions
(for-each
(fn (child)
(check-body-walk child comp-name type-env prim-types prim-param-types env diagnostics type-registry effect-annotations))
args)))))))
;; --------------------------------------------------------------------------
;; 10. Check a single component
;; --------------------------------------------------------------------------
(define check-component
(fn ((comp-name :as string) env (prim-types :as dict) prim-param-types type-registry effect-annotations)
;; Type-check a component's body. Returns list of diagnostics.
;; prim-param-types: dict of param type info, or nil to skip primitive checking.
;; type-registry: dict of {type-name → type-def} or nil
;; effect-annotations: dict of {fn-name → effect-list} or nil
(let ((comp (env-get env comp-name))
(diagnostics (list)))
(when (= (type-of comp) "component")
(let ((body (component-body comp))
(params (component-params comp))
(param-types (component-param-types comp))
;; Build initial type env from component params
(type-env (dict)))
;; Add param types (annotated or default to any)
(for-each
(fn (p)
(dict-set! type-env p
(if (and (not (nil? param-types))
(has-key? param-types p))
(get param-types p)
"any")))
params)
;; Add children as (list-of element) if component has children
(when (component-has-children comp)
(dict-set! type-env "children" (list "list-of" "element")))
(check-body-walk body comp-name type-env prim-types prim-param-types env diagnostics type-registry effect-annotations)))
diagnostics)))
;; --------------------------------------------------------------------------
;; 11. Check all components in an environment
;; --------------------------------------------------------------------------
(define check-all
(fn (env (prim-types :as dict) prim-param-types type-registry effect-annotations)
;; Type-check every component in the environment.
;; prim-param-types: dict of param type info, or nil to skip primitive checking.
;; type-registry: dict of {type-name → type-def} or nil
;; effect-annotations: dict of {fn-name → effect-list} or nil
;; Returns list of all diagnostics.
(let ((all-diagnostics (list)))
(for-each
(fn (name)
(let ((val (env-get env name)))
(when (= (type-of val) "component")
(for-each
(fn (d) (append! all-diagnostics d))
(check-component name env prim-types prim-param-types type-registry effect-annotations)))))
(keys env))
all-diagnostics)))
;; --------------------------------------------------------------------------
;; 12. Build primitive type registry
;; --------------------------------------------------------------------------
;; Builds a dict mapping primitive-name → return-type from
;; the declarations parsed by boundary_parser.py.
;; This is called by the host at startup with the parsed declarations.
(define build-type-registry
(fn ((prim-declarations :as list) (io-declarations :as list))
;; Both are lists of dicts: {:name "+" :returns "number" :params (...)}
;; Returns a flat dict: {"+" "number", "str" "string", ...}
(let ((registry (dict)))
(for-each
(fn (decl)
(let ((name (get decl "name"))
(returns (get decl "returns")))
(when (and (not (nil? name)) (not (nil? returns)))
(dict-set! registry name returns))))
prim-declarations)
(for-each
(fn (decl)
(let ((name (get decl "name"))
(returns (get decl "returns")))
(when (and (not (nil? name)) (not (nil? returns)))
(dict-set! registry name returns))))
io-declarations)
registry)))
;; --------------------------------------------------------------------------
;; 13. User-defined types (deftype)
;; --------------------------------------------------------------------------
;; Type definitions are plain dicts: {:name "price" :params [] :body "number"}
;; Stored in env under "*type-registry*" mapping type names to defs.
;; make-type-def and normalize-type-body are defined in eval.sx
;; (always compiled). They're available when types.sx is compiled as a spec module.
;; -- Standard type definitions --
;; These define the record types used throughout the type system itself.
;; Universal: nullable shorthand
(deftype (maybe a) (union a nil))
;; A type definition entry in the registry
(deftype type-def
{:name string :params list :body any})
;; A diagnostic produced by the type checker
(deftype diagnostic
{:level string :message string :component string? :expr any})
;; Primitive parameter type signature
(deftype prim-param-sig
{:positional list :rest-type string?})
;; Effect declarations
(defeffect io)
(defeffect mutation)
(defeffect render)
(define type-def-name
(fn (td) (get td "name")))
(define type-def-params
(fn (td) (get td "params")))
(define type-def-body
(fn (td) (get td "body")))
(define resolve-type
(fn (t registry)
;; Resolve a type through the registry.
;; Returns the resolved type representation.
(if (nil? registry) t
(cond
;; String — might be a named type alias
(= (type-of t) "string")
(if (has-key? registry t)
(let ((td (get registry t)))
(let ((params (type-def-params td))
(body (type-def-body td)))
(if (empty? params)
;; Simple alias — resolve the body recursively
(resolve-type body registry)
;; Parameterized with no args — return as-is
t)))
t)
;; List — might be parameterized type application or compound
(= (type-of t) "list")
(if (empty? t) t
(let ((head (first t)))
(cond
;; (or ...), (list-of ...), (-> ...) — recurse into members
(or (= head "or") (= head "list-of") (= head "->")
(= head "dict-of"))
(cons head (map (fn (m) (resolve-type m registry)) (rest t)))
;; Parameterized type application: ("maybe" "string") etc.
(and (= (type-of head) "string")
(has-key? registry head))
(let ((td (get registry head))
(params (type-def-params td))
(body (type-def-body td))
(args (rest t)))
(if (= (len params) (len args))
(resolve-type
(substitute-type-vars body params args)
registry)
;; Wrong arity — return as-is
t))
:else t)))
;; Dict — record type, resolve field types
(= (type-of t) "dict")
(map-dict (fn (k v) (resolve-type v registry)) t)
;; Anything else — return as-is
:else t))))
(define substitute-type-vars
(fn (body (params :as list) (args :as list))
;; Substitute type variables in body.
;; params is a list of type var names, args is corresponding types.
(let ((subst (dict)))
(for-each
(fn (i)
(dict-set! subst (nth params i) (nth args i)))
(range 0 (len params) 1))
(substitute-in-type body subst))))
(define substitute-in-type
(fn (t (subst :as dict))
;; Recursively substitute type variables.
(cond
(= (type-of t) "string")
(if (has-key? subst t) (get subst t) t)
(= (type-of t) "list")
(map (fn (m) (substitute-in-type m subst)) t)
(= (type-of t) "dict")
(map-dict (fn (k v) (substitute-in-type v subst)) t)
:else t)))
(define subtype-resolved?
(fn (a b registry)
;; Resolve both sides through the registry, then check subtype.
(if (nil? registry)
(subtype? a b)
(let ((ra (resolve-type a registry))
(rb (resolve-type b registry)))
;; Handle record structural subtyping: dict a <: dict b
;; if every field in b exists in a with compatible type
(if (and (= (type-of ra) "dict") (= (type-of rb) "dict"))
(every?
(fn (key)
(and (has-key? ra key)
(subtype-resolved? (get ra key) (get rb key) registry)))
(keys rb))
(subtype? ra rb))))))
;; --------------------------------------------------------------------------
;; 14. Effect checking (defeffect)
;; --------------------------------------------------------------------------
;; Effects are annotations on functions/components describing their
;; side effects. A pure function cannot call IO functions.
(define get-effects
(fn ((name :as string) effect-annotations)
;; Look up declared effects for a function/component.
;; Returns list of effect strings, or nil if unannotated.
(if (nil? effect-annotations) nil
(if (has-key? effect-annotations name)
(get effect-annotations name)
nil))))
(define effects-subset?
(fn (callee-effects caller-effects)
;; Are all callee effects allowed by caller?
;; nil effects = unannotated = assumed to have all effects.
;; Empty list = pure = no effects.
(if (nil? caller-effects) true ;; unannotated caller allows everything
(if (nil? callee-effects) true ;; unannotated callee — skip check
(every?
(fn (e) (contains? caller-effects e))
callee-effects)))))
(define check-effect-call
(fn ((callee-name :as string) caller-effects effect-annotations (comp-name :as string))
;; Check that callee's effects are allowed by caller's effects.
;; Returns list of diagnostics.
(let ((diagnostics (list))
(callee-effects (get-effects callee-name effect-annotations)))
(when (and (not (nil? caller-effects))
(not (nil? callee-effects))
(not (effects-subset? callee-effects caller-effects)))
(append! diagnostics
(make-diagnostic "error"
(str "`" callee-name "` has effects "
(join ", " callee-effects)
" but `" comp-name "` only allows "
(if (empty? caller-effects) "[pure]"
(join ", " caller-effects)))
comp-name nil)))
diagnostics)))
(define build-effect-annotations
(fn ((io-declarations :as list))
;; Assign [io] effect to all IO primitives.
(let ((annotations (dict)))
(for-each
(fn (decl)
(let ((name (get decl "name")))
(when (not (nil? name))
(dict-set! annotations name (list "io")))))
io-declarations)
annotations)))
;; --------------------------------------------------------------------------
;; 15. Check component effects — convenience wrapper
;; --------------------------------------------------------------------------
;; Validates that components respect their declared effect annotations.
;; Delegates to check-body-walk with nil type checking (effects only).
(define check-component-effects
(fn ((comp-name :as string) env effect-annotations)
;; Check a single component's effect usage. Returns diagnostics list.
;; Skips type checking — only checks effect violations.
(let ((comp (env-get env comp-name))
(diagnostics (list)))
(when (= (type-of comp) "component")
(let ((body (component-body comp)))
(check-body-walk body comp-name (dict) (dict) nil env
diagnostics nil effect-annotations)))
diagnostics)))
(define check-all-effects
(fn (env effect-annotations)
;; Check all components in env for effect violations.
;; Returns list of all diagnostics.
(let ((all-diagnostics (list)))
(for-each
(fn (name)
(let ((val (env-get env name)))
(when (= (type-of val) "component")
(for-each
(fn (d) (append! all-diagnostics d))
(check-component-effects name env effect-annotations)))))
(keys env))
all-diagnostics)))
;; --------------------------------------------------------------------------
;; Platform interface summary
;; --------------------------------------------------------------------------
;;
;; From eval.sx (already provided):
;; (type-of x), (symbol-name s), (keyword-name k), (env-get env k)
;; (component-body c), (component-params c), (component-has-children c)
;;
;; New for types.sx (each host implements):
;; (component-param-types c) → dict {param-name → type} or nil
;; (component-set-param-types! c d) → store param types on component
;; (merge d1 d2) → new dict merging d1 and d2
;;
;; Primitive param types:
;; The host provides prim-param-types as a dict mapping primitive names
;; to param type descriptors. Each descriptor is a dict:
;; {"positional" [["name" "type-or-nil"] ...] "rest-type" "type-or-nil"}
;; Built by boundary_parser.parse_primitive_param_types() in Python.
;; Passed to check-component/check-all as an optional extra argument.
;;
;; --------------------------------------------------------------------------

49
spec/boundary-core.sx
View File

@@ -1,49 +0,0 @@
;; ==========================================================================
;; boundary.sx — SX language boundary contract
;;
;; Declares the core I/O primitives that any SX host must provide.
;; This is the LANGUAGE contract — not deployment-specific.
;;
;; Pure primitives (Tier 1) are declared in primitives.sx.
;; Deployment-specific I/O lives in boundary-app.sx.
;; Per-service page helpers live in {service}/sx/boundary.sx.
;;
;; Format:
;; (define-io-primitive "name"
;; :params (param1 param2 &key ...)
;; :returns "type"
;; :effects [io]
;; :async true
;; :doc "description"
;; :context :request)
;;
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Tier 1: Pure primitives — declared in primitives.sx
;; --------------------------------------------------------------------------
(declare-tier :pure :source "primitives.sx")
;; --------------------------------------------------------------------------
;; Core platform primitives — type inspection + environment
;; --------------------------------------------------------------------------
;;
;; These are provided by every host. Not IO, not web-specific.
(declare-core-primitive "type-of"
:params (value)
:returns "string"
:doc "Return the type name of a value.")
(declare-core-primitive "make-env"
:params ()
:returns "dict"
:doc "Create a base environment with all primitives.")
(declare-core-primitive "identical?"
:params (a b)
:returns "boolean"
:doc "Reference equality check.")

241
spec/test-cek.sx
View File

@@ -1,241 +0,0 @@
;; ==========================================================================
;; test-cek.sx — Tests for the explicit CEK machine evaluator
;;
;; Tests that eval-expr-cek produces identical results to eval-expr.
;; Requires: test-framework.sx, frames.sx, cek.sx loaded.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Literals
;; --------------------------------------------------------------------------
(defsuite "cek-literals"
(deftest "number"
(assert-equal 42 (eval-expr-cek 42 (test-env))))
(deftest "string"
(assert-equal "hello" (eval-expr-cek "hello" (test-env))))
(deftest "boolean true"
(assert-equal true (eval-expr-cek true (test-env))))
(deftest "boolean false"
(assert-equal false (eval-expr-cek false (test-env))))
(deftest "nil"
(assert-nil (eval-expr-cek nil (test-env)))))
;; --------------------------------------------------------------------------
;; 2. Symbol lookup
;; --------------------------------------------------------------------------
(defsuite "cek-symbols"
(deftest "env lookup"
(assert-equal 42
(cek-eval "(do (define x 42) x)")))
(deftest "primitive call resolves"
(assert-equal "hello"
(cek-eval "(str \"hello\")"))))
;; --------------------------------------------------------------------------
;; 3. Special forms
;; --------------------------------------------------------------------------
(defsuite "cek-if"
(deftest "if true branch"
(assert-equal 1
(cek-eval "(if true 1 2)")))
(deftest "if false branch"
(assert-equal 2
(cek-eval "(if false 1 2)")))
(deftest "if no else"
(assert-nil (cek-eval "(if false 1)"))))
(defsuite "cek-when"
(deftest "when true"
(assert-equal 42
(cek-eval "(when true 42)")))
(deftest "when false"
(assert-nil (cek-eval "(when false 42)")))
(deftest "when multiple body"
(assert-equal 3
(cek-eval "(when true 1 2 3)"))))
(defsuite "cek-begin"
(deftest "do returns last"
(assert-equal 3
(cek-eval "(do 1 2 3)")))
(deftest "empty do"
(assert-nil (cek-eval "(do)"))))
(defsuite "cek-let"
(deftest "basic let"
(assert-equal 3
(cek-eval "(let ((x 1) (y 2)) (+ x y))")))
(deftest "let body sequence"
(assert-equal 10
(cek-eval "(let ((x 5)) 1 2 (+ x 5))")))
(deftest "nested let"
(assert-equal 5
(cek-eval "(let ((x 1)) (let ((y 2)) (+ x y (* x y))))"))))
(defsuite "cek-and-or"
(deftest "and all true"
(assert-equal 3
(cek-eval "(and 1 2 3)")))
(deftest "and short circuit"
(assert-false (cek-eval "(and 1 false 3)")))
(deftest "or first true"
(assert-equal 1
(cek-eval "(or 1 2 3)")))
(deftest "or all false"
(assert-false (cek-eval "(or false false false)"))))
(defsuite "cek-cond"
(deftest "cond first match"
(assert-equal "a"
(cek-eval "(cond true \"a\" true \"b\")")))
(deftest "cond second match"
(assert-equal "b"
(cek-eval "(cond false \"a\" true \"b\")")))
(deftest "cond else"
(assert-equal "c"
(cek-eval "(cond false \"a\" :else \"c\")"))))
(defsuite "cek-case"
(deftest "case match"
(assert-equal "yes"
(cek-eval "(case 1 1 \"yes\" 2 \"no\")")))
(deftest "case no match"
(assert-nil
(cek-eval "(case 3 1 \"yes\" 2 \"no\")")))
(deftest "case else"
(assert-equal "default"
(cek-eval "(case 3 1 \"yes\" :else \"default\")"))))
;; --------------------------------------------------------------------------
;; 4. Function calls
;; --------------------------------------------------------------------------
(defsuite "cek-calls"
(deftest "primitive call"
(assert-equal 3
(cek-eval "(+ 1 2)")))
(deftest "nested calls"
(assert-equal 6
(cek-eval "(+ 1 (+ 2 3))")))
(deftest "lambda call"
(assert-equal 10
(cek-eval "((fn (x) (* x 2)) 5)")))
(deftest "defined function"
(assert-equal 25
(cek-eval "(do (define square (fn (x) (* x x))) (square 5))"))))
;; --------------------------------------------------------------------------
;; 5. Define and set!
;; --------------------------------------------------------------------------
(defsuite "cek-define"
(deftest "define binds"
(assert-equal 42
(cek-eval "(do (define x 42) x)")))
(deftest "set! mutates"
(assert-equal 10
(cek-eval "(do (define x 1) (set! x 10) x)"))))
;; --------------------------------------------------------------------------
;; 6. Quote and quasiquote
;; --------------------------------------------------------------------------
(defsuite "cek-quote"
(deftest "quote"
(let ((result (cek-eval "(quote (1 2 3))")))
(assert-equal 3 (len result))))
(deftest "quasiquote with unquote"
(assert-equal (list 1 42 3)
(cek-eval "(let ((x 42)) `(1 ,x 3))"))))
;; --------------------------------------------------------------------------
;; 7. Thread-first
;; --------------------------------------------------------------------------
(defsuite "cek-thread-first"
(deftest "simple thread"
(assert-equal 3
(cek-eval "(-> 1 (+ 2))")))
(deftest "multi-step thread"
(assert-equal 6
(cek-eval "(-> 1 (+ 2) (* 2))"))))
;; --------------------------------------------------------------------------
;; 8. CEK-specific: stepping
;; --------------------------------------------------------------------------
(defsuite "cek-stepping"
(deftest "single step literal"
(let ((state (make-cek-state 42 (test-env) (list))))
(let ((stepped (cek-step state)))
(assert-equal "continue" (cek-phase stepped))
(assert-equal 42 (cek-value stepped))
(assert-true (cek-terminal? stepped)))))
(deftest "single step if pushes frame"
(let ((state (make-cek-state (sx-parse-one "(if true 1 2)") (test-env) (list))))
(let ((stepped (cek-step state)))
(assert-equal "eval" (cek-phase stepped))
;; Should have pushed an IfFrame
(assert-true (> (len (cek-kont stepped)) 0))
(assert-equal "if" (frame-type (first (cek-kont stepped))))))))
;; --------------------------------------------------------------------------
;; 9. Native continuations (shift/reset in CEK)
;; --------------------------------------------------------------------------
(defsuite "cek-continuations"
(deftest "reset passthrough"
(assert-equal 42
(cek-eval "(reset 42)")))
(deftest "shift abort"
(assert-equal 42
(cek-eval "(reset (+ 1 (shift k 42)))")))
(deftest "shift with invoke"
(assert-equal 11
(cek-eval "(reset (+ 1 (shift k (k 10))))"))))

140
spec/test-continuations.sx
View File

@@ -1,140 +0,0 @@
;; ==========================================================================
;; test-continuations.sx — Tests for delimited continuations (shift/reset)
;;
;; Requires: test-framework.sx loaded, continuations extension enabled.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Basic shift/reset
;; --------------------------------------------------------------------------
(defsuite "basic-shift-reset"
(deftest "reset passthrough"
(assert-equal 42 (reset 42)))
(deftest "reset evaluates expression"
(assert-equal 3 (reset (+ 1 2))))
(deftest "shift aborts to reset"
(assert-equal 42 (reset (+ 1 (shift k 42)))))
(deftest "shift with single invoke"
(assert-equal 11 (reset (+ 1 (shift k (k 10))))))
(deftest "shift with multiple invokes"
(assert-equal (list 11 21)
(reset (+ 1 (shift k (list (k 10) (k 20)))))))
(deftest "shift returns string"
(assert-equal "aborted"
(reset (+ 1 (shift k "aborted")))))
(deftest "shift returns nil"
(assert-nil (reset (+ 1 (shift k nil)))))
(deftest "nested expression with shift"
(assert-equal 16
(+ 1 (reset (+ 10 (shift k (k 5))))))))
;; --------------------------------------------------------------------------
;; 2. Continuation predicates
;; --------------------------------------------------------------------------
(defsuite "continuation-predicates"
(deftest "k is a continuation inside shift"
(assert-true
(reset (shift k (continuation? k)))))
(deftest "number is not a continuation"
(assert-false (continuation? 42)))
(deftest "function is not a continuation"
(assert-false (continuation? (fn (x) x))))
(deftest "nil is not a continuation"
(assert-false (continuation? nil)))
(deftest "string is not a continuation"
(assert-false (continuation? "hello"))))
;; --------------------------------------------------------------------------
;; 3. Continuation as value
;; --------------------------------------------------------------------------
(defsuite "continuation-as-value"
(deftest "k returned from reset"
;; shift body returns k itself — reset returns the continuation
(let ((k (reset (+ 1 (shift k k)))))
(assert-true (continuation? k))
(assert-equal 11 (k 10))))
(deftest "invoke returned k multiple times"
(let ((k (reset (+ 1 (shift k k)))))
(assert-equal 11 (k 10))
(assert-equal 21 (k 20))
(assert-equal 2 (k 1))))
(deftest "pass k to another function"
(let ((apply-k (fn (k v) (k v))))
(assert-equal 15
(reset (+ 5 (shift k (apply-k k 10)))))))
(deftest "k in data structure"
(let ((result (reset (+ 1 (shift k (list k 42))))))
(assert-equal 42 (nth result 1))
(assert-equal 100 ((first result) 99)))))
;; --------------------------------------------------------------------------
;; 4. Nested reset
;; --------------------------------------------------------------------------
(defsuite "nested-reset"
(deftest "inner reset captures independently"
(assert-equal 12
(reset (+ 1 (reset (+ 10 (shift k (k 1))))))))
(deftest "inner abort outer continues"
(assert-equal 43
(reset (+ 1 (reset (+ 10 (shift k 42)))))))
(deftest "outer shift captures outer reset"
(assert-equal 100
(reset (+ 1 (shift k (k 99)))))))
;; --------------------------------------------------------------------------
;; 5. Interaction with scoped effects
;; --------------------------------------------------------------------------
(defsuite "continuations-with-scopes"
(deftest "provide survives resume"
(assert-equal "dark"
(reset (provide "theme" "dark"
(+ 0 (shift k (k 0)))
(context "theme")))))
(deftest "scope and emit across shift"
(assert-equal (list "a")
(reset (scope "acc"
(emit! "acc" "a")
(+ 0 (shift k (k 0)))
(emitted "acc"))))))
;; --------------------------------------------------------------------------
;; 6. TCO interaction
;; --------------------------------------------------------------------------
(defsuite "tco-interaction"
(deftest "shift in tail position"
(assert-equal 42
(reset (if true (shift k (k 42)) 0))))
(deftest "shift in let body"
(assert-equal 10
(reset (let ((x 5))
(+ x (shift k (k 5))))))))

746
spec/test-eval.sx
View File

@@ -1,746 +0,0 @@
;; ==========================================================================
;; test-eval.sx — Tests for the core evaluator and primitives
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: eval.sx, primitives.sx
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Literals and types
;; --------------------------------------------------------------------------
(defsuite "literals"
(deftest "numbers are numbers"
(assert-type "number" 42)
(assert-type "number" 3.14)
(assert-type "number" -1))
(deftest "strings are strings"
(assert-type "string" "hello")
(assert-type "string" ""))
(deftest "booleans are booleans"
(assert-type "boolean" true)
(assert-type "boolean" false))
(deftest "nil is nil"
(assert-type "nil" nil)
(assert-nil nil))
(deftest "lists are lists"
(assert-type "list" (list 1 2 3))
(assert-type "list" (list)))
(deftest "dicts are dicts"
(assert-type "dict" {:a 1 :b 2})))
;; --------------------------------------------------------------------------
;; Arithmetic
;; --------------------------------------------------------------------------
(defsuite "arithmetic"
(deftest "addition"
(assert-equal 3 (+ 1 2))
(assert-equal 0 (+ 0 0))
(assert-equal -1 (+ 1 -2))
(assert-equal 10 (+ 1 2 3 4)))
(deftest "subtraction"
(assert-equal 1 (- 3 2))
(assert-equal -1 (- 2 3)))
(deftest "multiplication"
(assert-equal 6 (* 2 3))
(assert-equal 0 (* 0 100))
(assert-equal 24 (* 1 2 3 4)))
(deftest "division"
(assert-equal 2 (/ 6 3))
(assert-equal 2.5 (/ 5 2)))
(deftest "modulo"
(assert-equal 1 (mod 7 3))
(assert-equal 0 (mod 6 3))))
;; --------------------------------------------------------------------------
;; Comparison
;; --------------------------------------------------------------------------
(defsuite "comparison"
(deftest "equality"
(assert-true (= 1 1))
(assert-false (= 1 2))
(assert-true (= "a" "a"))
(assert-false (= "a" "b")))
(deftest "deep equality"
(assert-true (equal? (list 1 2 3) (list 1 2 3)))
(assert-false (equal? (list 1 2) (list 1 3)))
(assert-true (equal? {:a 1} {:a 1}))
(assert-false (equal? {:a 1} {:a 2})))
(deftest "ordering"
(assert-true (< 1 2))
(assert-false (< 2 1))
(assert-true (> 2 1))
(assert-true (<= 1 1))
(assert-true (<= 1 2))
(assert-true (>= 2 2))
(assert-true (>= 3 2))))
;; --------------------------------------------------------------------------
;; String operations
;; --------------------------------------------------------------------------
(defsuite "strings"
(deftest "str concatenation"
(assert-equal "abc" (str "a" "b" "c"))
(assert-equal "hello world" (str "hello" " " "world"))
(assert-equal "42" (str 42))
(assert-equal "" (str)))
(deftest "string-length"
(assert-equal 5 (string-length "hello"))
(assert-equal 0 (string-length "")))
(deftest "substring"
(assert-equal "ell" (substring "hello" 1 4))
(assert-equal "hello" (substring "hello" 0 5)))
(deftest "string-contains?"
(assert-true (string-contains? "hello world" "world"))
(assert-false (string-contains? "hello" "xyz")))
(deftest "upcase and downcase"
(assert-equal "HELLO" (upcase "hello"))
(assert-equal "hello" (downcase "HELLO")))
(deftest "trim"
(assert-equal "hello" (trim " hello "))
(assert-equal "hello" (trim "hello")))
(deftest "split and join"
(assert-equal (list "a" "b" "c") (split "a,b,c" ","))
(assert-equal "a-b-c" (join "-" (list "a" "b" "c")))))
;; --------------------------------------------------------------------------
;; List operations
;; --------------------------------------------------------------------------
(defsuite "lists"
(deftest "constructors"
(assert-equal (list 1 2 3) (list 1 2 3))
(assert-equal (list) (list))
(assert-length 3 (list 1 2 3)))
(deftest "first and rest"
(assert-equal 1 (first (list 1 2 3)))
(assert-equal (list 2 3) (rest (list 1 2 3)))
(assert-nil (first (list)))
(assert-equal (list) (rest (list))))
(deftest "nth"
(assert-equal 1 (nth (list 1 2 3) 0))
(assert-equal 2 (nth (list 1 2 3) 1))
(assert-equal 3 (nth (list 1 2 3) 2)))
(deftest "last"
(assert-equal 3 (last (list 1 2 3)))
(assert-nil (last (list))))
(deftest "cons and append"
(assert-equal (list 0 1 2) (cons 0 (list 1 2)))
(assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4))))
(deftest "reverse"
(assert-equal (list 3 2 1) (reverse (list 1 2 3)))
(assert-equal (list) (reverse (list))))
(deftest "empty?"
(assert-true (empty? (list)))
(assert-false (empty? (list 1))))
(deftest "len"
(assert-equal 0 (len (list)))
(assert-equal 3 (len (list 1 2 3))))
(deftest "contains?"
(assert-true (contains? (list 1 2 3) 2))
(assert-false (contains? (list 1 2 3) 4)))
(deftest "flatten"
(assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4))))))
;; --------------------------------------------------------------------------
;; Dict operations
;; --------------------------------------------------------------------------
(defsuite "dicts"
(deftest "dict literal"
(assert-type "dict" {:a 1 :b 2})
(assert-equal 1 (get {:a 1} "a"))
(assert-equal 2 (get {:a 1 :b 2} "b")))
(deftest "assoc"
(assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2))
(assert-equal {:a 99} (assoc {:a 1} "a" 99)))
(deftest "dissoc"
(assert-equal {:b 2} (dissoc {:a 1 :b 2} "a")))
(deftest "keys and vals"
(let ((d {:a 1 :b 2}))
(assert-length 2 (keys d))
(assert-length 2 (vals d))
(assert-contains "a" (keys d))
(assert-contains "b" (keys d))))
(deftest "has-key?"
(assert-true (has-key? {:a 1} "a"))
(assert-false (has-key? {:a 1} "b")))
(deftest "merge"
(assert-equal {:a 1 :b 2 :c 3}
(merge {:a 1 :b 2} {:c 3}))
(assert-equal {:a 99 :b 2}
(merge {:a 1 :b 2} {:a 99}))))
;; --------------------------------------------------------------------------
;; Predicates
;; --------------------------------------------------------------------------
(defsuite "predicates"
(deftest "nil?"
(assert-true (nil? nil))
(assert-false (nil? 0))
(assert-false (nil? false))
(assert-false (nil? "")))
(deftest "number?"
(assert-true (number? 42))
(assert-true (number? 3.14))
(assert-false (number? "42")))
(deftest "string?"
(assert-true (string? "hello"))
(assert-false (string? 42)))
(deftest "list?"
(assert-true (list? (list 1 2)))
(assert-false (list? "not a list")))
(deftest "dict?"
(assert-true (dict? {:a 1}))
(assert-false (dict? (list 1))))
(deftest "boolean?"
(assert-true (boolean? true))
(assert-true (boolean? false))
(assert-false (boolean? nil))
(assert-false (boolean? 0)))
(deftest "not"
(assert-true (not false))
(assert-true (not nil))
(assert-false (not true))
(assert-false (not 1))
(assert-false (not "x"))))
;; --------------------------------------------------------------------------
;; Special forms
;; --------------------------------------------------------------------------
(defsuite "special-forms"
(deftest "if"
(assert-equal "yes" (if true "yes" "no"))
(assert-equal "no" (if false "yes" "no"))
(assert-equal "no" (if nil "yes" "no"))
(assert-nil (if false "yes")))
(deftest "when"
(assert-equal "yes" (when true "yes"))
(assert-nil (when false "yes")))
(deftest "cond"
(assert-equal "a" (cond true "a" :else "b"))
(assert-equal "b" (cond false "a" :else "b"))
(assert-equal "c" (cond
false "a"
false "b"
:else "c")))
(deftest "cond with 2-element predicate as first test"
;; Regression: cond misclassifies Clojure-style as scheme-style when
;; the first test is a 2-element list like (nil? x) or (empty? x).
;; The evaluator checks: is first arg a 2-element list? If yes, treats
;; as scheme-style ((test body) ...) — returning the arg instead of
;; evaluating the predicate call.
(assert-equal 0 (cond (nil? nil) 0 :else 1))
(assert-equal 1 (cond (nil? "x") 0 :else 1))
(assert-equal "empty" (cond (empty? (list)) "empty" :else "not-empty"))
(assert-equal "not-empty" (cond (empty? (list 1)) "empty" :else "not-empty"))
(assert-equal "yes" (cond (not false) "yes" :else "no"))
(assert-equal "no" (cond (not true) "yes" :else "no")))
(deftest "cond with 2-element predicate and no :else"
;; Same bug, but without :else — this is the worst case because the
;; bootstrapper heuristic also breaks (all clauses are 2-element lists).
(assert-equal "found"
(cond (nil? nil) "found"
(nil? "x") "other"))
(assert-equal "b"
(cond (nil? "x") "a"
(not false) "b")))
(deftest "and"
(assert-true (and true true))
(assert-false (and true false))
(assert-false (and false true))
(assert-equal 3 (and 1 2 3)))
(deftest "or"
(assert-equal 1 (or 1 2))
(assert-equal 2 (or false 2))
(assert-equal "fallback" (or nil false "fallback"))
(assert-false (or false false)))
(deftest "let"
(assert-equal 3 (let ((x 1) (y 2)) (+ x y)))
(assert-equal "hello world"
(let ((a "hello") (b " world")) (str a b))))
(deftest "let clojure-style"
(assert-equal 3 (let (x 1 y 2) (+ x y))))
(deftest "do / begin"
(assert-equal 3 (do 1 2 3))
(assert-equal "last" (begin "first" "middle" "last")))
(deftest "define"
(define x 42)
(assert-equal 42 x))
(deftest "set!"
(define x 1)
(set! x 2)
(assert-equal 2 x)))
;; --------------------------------------------------------------------------
;; Lambda and closures
;; --------------------------------------------------------------------------
(defsuite "lambdas"
(deftest "basic lambda"
(let ((add (fn (a b) (+ a b))))
(assert-equal 3 (add 1 2))))
(deftest "closure captures env"
(let ((x 10))
(let ((add-x (fn (y) (+ x y))))
(assert-equal 15 (add-x 5)))))
(deftest "lambda as argument"
(assert-equal (list 2 4 6)
(map (fn (x) (* x 2)) (list 1 2 3))))
(deftest "recursive lambda via define"
(define factorial
(fn (n) (if (<= n 1) 1 (* n (factorial (- n 1))))))
(assert-equal 120 (factorial 5)))
(deftest "higher-order returns lambda"
(let ((make-adder (fn (n) (fn (x) (+ n x)))))
(let ((add5 (make-adder 5)))
(assert-equal 8 (add5 3)))))
(deftest "multi-body lambda returns last value"
;; All body expressions must execute. Return value is the last.
;; Catches: sf-lambda using nth(args,1) instead of rest(args).
(let ((f (fn (x) (+ x 1) (+ x 2) (+ x 3))))
(assert-equal 13 (f 10))))
(deftest "multi-body lambda side effects via dict mutation"
;; Verify all body expressions run by mutating a shared dict.
(let ((state (dict "a" 0 "b" 0)))
(let ((f (fn ()
(dict-set! state "a" 1)
(dict-set! state "b" 2)
"done")))
(assert-equal "done" (f))
(assert-equal 1 (get state "a"))
(assert-equal 2 (get state "b")))))
(deftest "multi-body lambda two expressions"
;; Simplest case: two body expressions, return value is second.
(assert-equal 20
((fn (x) (+ x 1) (* x 2)) 10))
;; And with zero-arg lambda
(assert-equal 42
((fn () (+ 1 2) 42)))))
;; --------------------------------------------------------------------------
;; Higher-order forms
;; --------------------------------------------------------------------------
(defsuite "higher-order"
(deftest "map"
(assert-equal (list 2 4 6)
(map (fn (x) (* x 2)) (list 1 2 3)))
(assert-equal (list) (map (fn (x) x) (list))))
(deftest "filter"
(assert-equal (list 2 4)
(filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4)))
(assert-equal (list)
(filter (fn (x) false) (list 1 2 3))))
(deftest "reduce"
(assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)))
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))))
(deftest "some"
(assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5)))
(assert-false (some (fn (x) (> x 10)) (list 1 2 3))))
(deftest "every?"
(assert-true (every? (fn (x) (> x 0)) (list 1 2 3)))
(assert-false (every? (fn (x) (> x 2)) (list 1 2 3))))
(deftest "map-indexed"
(assert-equal (list "0:a" "1:b" "2:c")
(map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c")))))
;; --------------------------------------------------------------------------
;; Components
;; --------------------------------------------------------------------------
(defsuite "components"
(deftest "defcomp creates component"
(defcomp ~test-comp (&key title)
(div title))
(assert-true (not (nil? ~test-comp))))
(deftest "component renders with keyword args"
(defcomp ~greeting (&key name)
(span (str "Hello, " name "!")))
(assert-true (not (nil? ~greeting))))
(deftest "component with children"
(defcomp ~box (&key &rest children)
(div :class "box" children))
(assert-true (not (nil? ~box))))
(deftest "component with default via or"
(defcomp ~label (&key text)
(span (or text "default")))
(assert-true (not (nil? ~label))))
(deftest "defcomp default affinity is auto"
(defcomp ~aff-default (&key x)
(div x))
(assert-equal "auto" (component-affinity ~aff-default)))
(deftest "defcomp affinity client"
(defcomp ~aff-client (&key x)
:affinity :client
(div x))
(assert-equal "client" (component-affinity ~aff-client)))
(deftest "defcomp affinity server"
(defcomp ~aff-server (&key x)
:affinity :server
(div x))
(assert-equal "server" (component-affinity ~aff-server)))
(deftest "defcomp affinity preserves body"
(defcomp ~aff-body (&key val)
:affinity :client
(span val))
;; Component should still render correctly
(assert-equal "client" (component-affinity ~aff-body))
(assert-true (not (nil? ~aff-body)))))
;; --------------------------------------------------------------------------
;; Macros
;; --------------------------------------------------------------------------
(defsuite "macros"
(deftest "defmacro creates macro"
(defmacro unless (cond &rest body)
`(if (not ,cond) (do ,@body)))
(assert-equal "yes" (unless false "yes"))
(assert-nil (unless true "no")))
(deftest "quasiquote and unquote"
(let ((x 42))
(assert-equal (list 1 42 3) `(1 ,x 3))))
(deftest "splice-unquote"
(let ((xs (list 2 3 4)))
(assert-equal (list 1 2 3 4 5) `(1 ,@xs 5)))))
;; --------------------------------------------------------------------------
;; Threading macro
;; --------------------------------------------------------------------------
(defsuite "threading"
(deftest "thread-first"
(assert-equal 8 (-> 5 (+ 1) (+ 2)))
(assert-equal "HELLO" (-> "hello" upcase))
(assert-equal "HELLO WORLD"
(-> "hello"
(str " world")
upcase))))
;; --------------------------------------------------------------------------
;; Truthiness
;; --------------------------------------------------------------------------
(defsuite "truthiness"
(deftest "truthy values"
(assert-true (if 1 true false))
(assert-true (if "x" true false))
(assert-true (if (list 1) true false))
(assert-true (if true true false)))
(deftest "falsy values"
(assert-false (if false true false))
(assert-false (if nil true false)))
;; NOTE: empty list, zero, and empty string truthiness is
;; platform-dependent. Python treats all three as falsy.
;; JavaScript treats [] as truthy but 0 and "" as falsy.
;; These tests are omitted — each bootstrapper should emit
;; platform-specific truthiness tests instead.
)
;; --------------------------------------------------------------------------
;; Edge cases and regression tests
;; --------------------------------------------------------------------------
(defsuite "edge-cases"
(deftest "nested let scoping"
(let ((x 1))
(let ((x 2))
(assert-equal 2 x))
;; outer x should be unchanged by inner let
;; (this tests that let creates a new scope)
))
(deftest "recursive map"
(assert-equal (list (list 2 4) (list 6 8))
(map (fn (sub) (map (fn (x) (* x 2)) sub))
(list (list 1 2) (list 3 4)))))
(deftest "keyword as value"
(assert-equal "class" :class)
(assert-equal "id" :id))
(deftest "dict with evaluated values"
(let ((x 42))
(assert-equal 42 (get {:val x} "val"))))
(deftest "nil propagation"
(assert-nil (get {:a 1} "missing"))
(assert-equal "default" (or (get {:a 1} "missing") "default")))
(deftest "empty operations"
(assert-equal (list) (map (fn (x) x) (list)))
(assert-equal (list) (filter (fn (x) true) (list)))
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))
(assert-equal 0 (len (list)))
(assert-equal "" (str))))
;; --------------------------------------------------------------------------
;; Server-only tests — skip in browser (defpage, streaming functions)
;; These require forms.sx which is only loaded server-side.
;; --------------------------------------------------------------------------
(when (get (try-call (fn () stream-chunk-id)) "ok")
(defsuite "defpage"
(deftest "basic defpage returns page-def"
(let ((p (defpage test-basic :path "/test" :auth :public :content (div "hello"))))
(assert-true (not (nil? p)))
(assert-equal "test-basic" (get p "name"))
(assert-equal "/test" (get p "path"))
(assert-equal "public" (get p "auth"))))
(deftest "defpage content expr is unevaluated AST"
(let ((p (defpage test-content :path "/c" :auth :public :content (~my-comp :title "hi"))))
(assert-true (not (nil? (get p "content"))))))
(deftest "defpage with :stream"
(let ((p (defpage test-stream :path "/s" :auth :public :stream true :content (div "x"))))
(assert-equal true (get p "stream"))))
(deftest "defpage with :shell"
(let ((p (defpage test-shell :path "/sh" :auth :public :stream true
:shell (~my-layout (~suspense :id "data" :fallback (div "loading...")))
:content (~my-streamed :data data-val))))
(assert-true (not (nil? (get p "shell"))))
(assert-true (not (nil? (get p "content"))))))
(deftest "defpage with :fallback"
(let ((p (defpage test-fallback :path "/f" :auth :public :stream true
:fallback (div :class "skeleton" "loading")
:content (div "done"))))
(assert-true (not (nil? (get p "fallback"))))))
(deftest "defpage with :data"
(let ((p (defpage test-data :path "/d" :auth :public
:data (fetch-items)
:content (~items-list :items items))))
(assert-true (not (nil? (get p "data"))))))
(deftest "defpage missing fields are nil"
(let ((p (defpage test-minimal :path "/m" :auth :public :content (div "x"))))
(assert-nil (get p "data"))
(assert-nil (get p "filter"))
(assert-nil (get p "aside"))
(assert-nil (get p "menu"))
(assert-nil (get p "shell"))
(assert-nil (get p "fallback"))
(assert-equal false (get p "stream")))))
;; --------------------------------------------------------------------------
;; Multi-stream data protocol (from forms.sx)
;; --------------------------------------------------------------------------
(defsuite "stream-chunk-id"
(deftest "extracts stream-id from chunk"
(assert-equal "my-slot" (stream-chunk-id {"stream-id" "my-slot" "x" 1})))
(deftest "defaults to stream-content when missing"
(assert-equal "stream-content" (stream-chunk-id {"x" 1 "y" 2}))))
(defsuite "stream-chunk-bindings"
(deftest "removes stream-id from chunk"
(let ((bindings (stream-chunk-bindings {"stream-id" "slot" "name" "alice" "age" 30})))
(assert-equal "alice" (get bindings "name"))
(assert-equal 30 (get bindings "age"))
(assert-nil (get bindings "stream-id"))))
(deftest "returns all keys when no stream-id"
(let ((bindings (stream-chunk-bindings {"a" 1 "b" 2})))
(assert-equal 1 (get bindings "a"))
(assert-equal 2 (get bindings "b")))))
(defsuite "normalize-binding-key"
(deftest "converts underscores to hyphens"
(assert-equal "my-key" (normalize-binding-key "my_key")))
(deftest "leaves hyphens unchanged"
(assert-equal "my-key" (normalize-binding-key "my-key")))
(deftest "handles multiple underscores"
(assert-equal "a-b-c" (normalize-binding-key "a_b_c"))))
(defsuite "bind-stream-chunk"
(deftest "creates fresh env with bindings"
(let ((base {"existing" 42})
(chunk {"stream-id" "slot" "user-name" "bob" "count" 5})
(env (bind-stream-chunk chunk base)))
;; Base env bindings are preserved
(assert-equal 42 (get env "existing"))
;; Chunk bindings are added (stream-id removed)
(assert-equal "bob" (get env "user-name"))
(assert-equal 5 (get env "count"))
;; stream-id is not in env
(assert-nil (get env "stream-id"))))
(deftest "isolates env from base — bindings don't leak to base"
(let ((base {"x" 1})
(chunk {"stream-id" "s" "y" 2})
(env (bind-stream-chunk chunk base)))
;; Chunk bindings should not appear in base
(assert-nil (get base "y"))
;; Base bindings should be in derived env
(assert-equal 1 (get env "x")))))
(defsuite "validate-stream-data"
(deftest "valid: list of dicts"
(assert-true (validate-stream-data
(list {"stream-id" "a" "x" 1}
{"stream-id" "b" "y" 2}))))
(deftest "valid: empty list"
(assert-true (validate-stream-data (list))))
(deftest "invalid: single dict (not a list)"
(assert-equal false (validate-stream-data {"x" 1})))
(deftest "invalid: list containing non-dict"
(assert-equal false (validate-stream-data (list {"x" 1} "oops" {"y" 2})))))
;; --------------------------------------------------------------------------
;; Multi-stream end-to-end scenarios
;; --------------------------------------------------------------------------
(defsuite "multi-stream routing"
(deftest "stream-chunk-id routes different chunks to different slots"
(let ((chunks (list
{"stream-id" "stream-fast" "msg" "quick"}
{"stream-id" "stream-medium" "msg" "steady"}
{"stream-id" "stream-slow" "msg" "slow"}))
(ids (map stream-chunk-id chunks)))
(assert-equal "stream-fast" (nth ids 0))
(assert-equal "stream-medium" (nth ids 1))
(assert-equal "stream-slow" (nth ids 2))))
(deftest "bind-stream-chunk creates isolated envs per chunk"
(let ((base {"layout" "main"})
(chunk-a {"stream-id" "a" "title" "First" "count" 1})
(chunk-b {"stream-id" "b" "title" "Second" "count" 2})
(env-a (bind-stream-chunk chunk-a base))
(env-b (bind-stream-chunk chunk-b base)))
;; Each env has its own bindings
(assert-equal "First" (get env-a "title"))
(assert-equal "Second" (get env-b "title"))
(assert-equal 1 (get env-a "count"))
(assert-equal 2 (get env-b "count"))
;; Both share base
(assert-equal "main" (get env-a "layout"))
(assert-equal "main" (get env-b "layout"))
;; Neither leaks into base
(assert-nil (get base "title"))))
(deftest "normalize-binding-key applied to chunk keys"
(let ((chunk {"stream-id" "s" "user_name" "alice" "item_count" 3})
(bindings (stream-chunk-bindings chunk)))
;; Keys with underscores need normalizing for SX env
(assert-equal "alice" (get bindings "user_name"))
;; normalize-binding-key converts them
(assert-equal "user-name" (normalize-binding-key "user_name"))
(assert-equal "item-count" (normalize-binding-key "item_count"))))
(deftest "defpage stream flag defaults to false"
(let ((p (defpage test-no-stream :path "/ns" :auth :public :content (div "x"))))
(assert-equal false (get p "stream"))))
(deftest "defpage stream true recorded in page-def"
(let ((p (defpage test-with-stream :path "/ws" :auth :public
:stream true
:shell (~layout (~suspense :id "data"))
:content (~chunk :val val))))
(assert-equal true (get p "stream"))
(assert-true (not (nil? (get p "shell")))))))
) ;; end (when has-server-forms?)

86
spec/test-framework.sx
View File

@@ -1,86 +0,0 @@
;; ==========================================================================
;; test-framework.sx — Reusable test macros and assertion helpers
;;
;; Loaded first by all test runners. Provides deftest, defsuite, and
;; assertion helpers. Requires 5 platform functions from the host:
;;
;; try-call (thunk) -> {:ok true} | {:ok false :error "msg"}
;; report-pass (name) -> platform-specific pass output
;; report-fail (name error) -> platform-specific fail output
;; push-suite (name) -> push suite name onto context stack
;; pop-suite () -> pop suite name from context stack
;;
;; Any host that provides these 5 functions can run any test spec.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Test framework macros
;; --------------------------------------------------------------------------
(defmacro deftest (name &rest body)
`(let ((result (try-call (fn () ,@body))))
(if (get result "ok")
(report-pass ,name)
(report-fail ,name (get result "error")))))
(defmacro defsuite (name &rest items)
`(do (push-suite ,name)
,@items
(pop-suite)))
;; --------------------------------------------------------------------------
;; 2. Assertion helpers — defined in SX, available in test bodies
;; --------------------------------------------------------------------------
(define assert-equal
(fn (expected actual)
(assert (equal? expected actual)
(str "Expected " (str expected) " but got " (str actual)))))
(define assert-not-equal
(fn (a b)
(assert (not (equal? a b))
(str "Expected values to differ but both are " (str a)))))
(define assert-true
(fn (val)
(assert val (str "Expected truthy but got " (str val)))))
(define assert-false
(fn (val)
(assert (not val) (str "Expected falsy but got " (str val)))))
(define assert-nil
(fn (val)
(assert (nil? val) (str "Expected nil but got " (str val)))))
(define assert-type
(fn ((expected-type :as string) val)
(let ((actual-type
(if (nil? val) "nil"
(if (boolean? val) "boolean"
(if (number? val) "number"
(if (string? val) "string"
(if (list? val) "list"
(if (dict? val) "dict"
"unknown"))))))))
(assert (= expected-type actual-type)
(str "Expected type " expected-type " but got " actual-type)))))
(define assert-length
(fn ((expected-len :as number) (col :as list))
(assert (= (len col) expected-len)
(str "Expected length " expected-len " but got " (len col)))))
(define assert-contains
(fn (item (col :as list))
(assert (some (fn (x) (equal? x item)) col)
(str "Expected collection to contain " (str item)))))
(define assert-throws
(fn ((thunk :as lambda))
(let ((result (try-call thunk)))
(assert (not (get result "ok"))
"Expected an error to be thrown but none was"))))

259
spec/test-parser.sx
View File

@@ -1,259 +0,0 @@
;; ==========================================================================
;; test-parser.sx — Tests for the SX parser and serializer
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: parser.sx
;;
;; Platform functions required (beyond test framework):
;; sx-parse (source) -> list of AST expressions
;; sx-serialize (expr) -> SX source string
;; make-symbol (name) -> Symbol value
;; make-keyword (name) -> Keyword value
;; symbol-name (sym) -> string
;; keyword-name (kw) -> string
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Literal parsing
;; --------------------------------------------------------------------------
(defsuite "parser-literals"
(deftest "parse integers"
(assert-equal (list 42) (sx-parse "42"))
(assert-equal (list 0) (sx-parse "0"))
(assert-equal (list -7) (sx-parse "-7")))
(deftest "parse floats"
(assert-equal (list 3.14) (sx-parse "3.14"))
(assert-equal (list -0.5) (sx-parse "-0.5")))
(deftest "parse strings"
(assert-equal (list "hello") (sx-parse "\"hello\""))
(assert-equal (list "") (sx-parse "\"\"")))
(deftest "parse escape: newline"
(assert-equal (list "a\nb") (sx-parse "\"a\\nb\"")))
(deftest "parse escape: tab"
(assert-equal (list "a\tb") (sx-parse "\"a\\tb\"")))
(deftest "parse escape: quote"
(assert-equal (list "a\"b") (sx-parse "\"a\\\"b\"")))
(deftest "parse booleans"
(assert-equal (list true) (sx-parse "true"))
(assert-equal (list false) (sx-parse "false")))
(deftest "parse nil"
(assert-equal (list nil) (sx-parse "nil")))
(deftest "parse keywords"
(let ((result (sx-parse ":hello")))
(assert-length 1 result)
(assert-equal "hello" (keyword-name (first result)))))
(deftest "parse symbols"
(let ((result (sx-parse "foo")))
(assert-length 1 result)
(assert-equal "foo" (symbol-name (first result))))))
;; --------------------------------------------------------------------------
;; Composite parsing
;; --------------------------------------------------------------------------
(defsuite "parser-lists"
(deftest "parse empty list"
(let ((result (sx-parse "()")))
(assert-length 1 result)
(assert-equal (list) (first result))))
(deftest "parse list of numbers"
(let ((result (sx-parse "(1 2 3)")))
(assert-length 1 result)
(assert-equal (list 1 2 3) (first result))))
(deftest "parse nested lists"
(let ((result (sx-parse "(1 (2 3) 4)")))
(assert-length 1 result)
(assert-equal (list 1 (list 2 3) 4) (first result))))
(deftest "parse square brackets as list"
(let ((result (sx-parse "[1 2 3]")))
(assert-length 1 result)
(assert-equal (list 1 2 3) (first result))))
(deftest "parse mixed types"
(let ((result (sx-parse "(42 \"hello\" true nil)")))
(assert-length 1 result)
(let ((lst (first result)))
(assert-equal 42 (nth lst 0))
(assert-equal "hello" (nth lst 1))
(assert-equal true (nth lst 2))
(assert-nil (nth lst 3))))))
;; --------------------------------------------------------------------------
;; Dict parsing
;; --------------------------------------------------------------------------
(defsuite "parser-dicts"
(deftest "parse empty dict"
(let ((result (sx-parse "{}")))
(assert-length 1 result)
(assert-type "dict" (first result))))
(deftest "parse dict with keyword keys"
(let ((result (sx-parse "{:a 1 :b 2}")))
(assert-length 1 result)
(let ((d (first result)))
(assert-type "dict" d)
(assert-equal 1 (get d "a"))
(assert-equal 2 (get d "b")))))
(deftest "parse dict with string values"
(let ((result (sx-parse "{:name \"alice\"}")))
(assert-length 1 result)
(assert-equal "alice" (get (first result) "name")))))
;; --------------------------------------------------------------------------
;; Comments and whitespace
;; --------------------------------------------------------------------------
(defsuite "parser-whitespace"
(deftest "skip line comments"
(assert-equal (list 42) (sx-parse ";; comment\n42"))
(assert-equal (list 1 2) (sx-parse "1 ;; middle\n2")))
(deftest "skip whitespace"
(assert-equal (list 42) (sx-parse " 42 "))
(assert-equal (list 1 2) (sx-parse " 1 \n\t 2 ")))
(deftest "parse multiple top-level expressions"
(assert-length 3 (sx-parse "1 2 3"))
(assert-equal (list 1 2 3) (sx-parse "1 2 3")))
(deftest "empty input"
(assert-equal (list) (sx-parse "")))
(deftest "only comments"
(assert-equal (list) (sx-parse ";; just a comment\n;; another"))))
;; --------------------------------------------------------------------------
;; Quote sugar
;; --------------------------------------------------------------------------
(defsuite "parser-quote-sugar"
(deftest "quasiquote"
(let ((result (sx-parse "`foo")))
(assert-length 1 result)
(let ((expr (first result)))
(assert-type "list" expr)
(assert-equal "quasiquote" (symbol-name (first expr))))))
(deftest "unquote"
(let ((result (sx-parse ",foo")))
(assert-length 1 result)
(let ((expr (first result)))
(assert-type "list" expr)
(assert-equal "unquote" (symbol-name (first expr))))))
(deftest "splice-unquote"
(let ((result (sx-parse ",@foo")))
(assert-length 1 result)
(let ((expr (first result)))
(assert-type "list" expr)
(assert-equal "splice-unquote" (symbol-name (first expr)))))))
;; --------------------------------------------------------------------------
;; Serializer
;; --------------------------------------------------------------------------
(defsuite "serializer"
(deftest "serialize number"
(assert-equal "42" (sx-serialize 42)))
(deftest "serialize string"
(assert-equal "\"hello\"" (sx-serialize "hello")))
(deftest "serialize boolean"
(assert-equal "true" (sx-serialize true))
(assert-equal "false" (sx-serialize false)))
(deftest "serialize nil"
(assert-equal "nil" (sx-serialize nil)))
(deftest "serialize keyword"
(assert-equal ":foo" (sx-serialize (make-keyword "foo"))))
(deftest "serialize symbol"
(assert-equal "bar" (sx-serialize (make-symbol "bar"))))
(deftest "serialize list"
(assert-equal "(1 2 3)" (sx-serialize (list 1 2 3))))
(deftest "serialize empty list"
(assert-equal "()" (sx-serialize (list))))
(deftest "serialize nested"
(assert-equal "(1 (2 3) 4)" (sx-serialize (list 1 (list 2 3) 4)))))
;; --------------------------------------------------------------------------
;; Round-trip: parse then serialize
;; --------------------------------------------------------------------------
(defsuite "parser-roundtrip"
(deftest "roundtrip number"
(assert-equal "42" (sx-serialize (first (sx-parse "42")))))
(deftest "roundtrip string"
(assert-equal "\"hello\"" (sx-serialize (first (sx-parse "\"hello\"")))))
(deftest "roundtrip list"
(assert-equal "(1 2 3)" (sx-serialize (first (sx-parse "(1 2 3)")))))
(deftest "roundtrip nested"
(assert-equal "(a (b c))"
(sx-serialize (first (sx-parse "(a (b c))"))))))
;; --------------------------------------------------------------------------
;; Reader macros
;; --------------------------------------------------------------------------
(defsuite "reader-macros"
(deftest "datum comment discards expr"
(assert-equal (list 42) (sx-parse "#;(ignored) 42")))
(deftest "datum comment in list"
(assert-equal (list (list 1 3)) (sx-parse "(1 #;2 3)")))
(deftest "datum comment discards nested"
(assert-equal (list 99) (sx-parse "#;(a (b c) d) 99")))
(deftest "raw string basic"
(assert-equal (list "hello") (sx-parse "#|hello|")))
(deftest "raw string with quotes"
(assert-equal (list "say \"hi\"") (sx-parse "#|say \"hi\"|")))
(deftest "raw string with backslashes"
(assert-equal (list "a\\nb") (sx-parse "#|a\\nb|")))
(deftest "raw string empty"
(assert-equal (list "") (sx-parse "#||")))
(deftest "quote shorthand symbol"
(let ((result (first (sx-parse "#'foo"))))
(assert-equal "quote" (symbol-name (first result)))
(assert-equal "foo" (symbol-name (nth result 1)))))
(deftest "quote shorthand list"
(let ((result (first (sx-parse "#'(1 2 3)"))))
(assert-equal "quote" (symbol-name (first result)))
(assert-equal (list 1 2 3) (nth result 1)))))

230
spec/test-render.sx
View File

@@ -1,230 +0,0 @@
;; ==========================================================================
;; test-render.sx — Tests for the HTML rendering adapter
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: render.sx, adapter-html.sx
;;
;; Platform functions required (beyond test framework):
;; render-html (sx-source) -> HTML string
;; Parses the sx-source string, evaluates via render-to-html in a
;; fresh env, and returns the resulting HTML string.
;; (This is a test-only convenience that wraps parse + render-to-html.)
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Basic element rendering
;; --------------------------------------------------------------------------
(defsuite "render-elements"
(deftest "simple div"
(assert-equal "<div>hello</div>"
(render-html "(div \"hello\")")))
(deftest "nested elements"
(assert-equal "<div><span>hi</span></div>"
(render-html "(div (span \"hi\"))")))
(deftest "multiple children"
(assert-equal "<div><p>a</p><p>b</p></div>"
(render-html "(div (p \"a\") (p \"b\"))")))
(deftest "text content"
(assert-equal "<p>hello world</p>"
(render-html "(p \"hello\" \" world\")")))
(deftest "number content"
(assert-equal "<span>42</span>"
(render-html "(span 42)"))))
;; --------------------------------------------------------------------------
;; Attributes
;; --------------------------------------------------------------------------
(defsuite "render-attrs"
(deftest "string attribute"
(let ((html (render-html "(div :id \"main\" \"content\")")))
(assert-true (string-contains? html "id=\"main\""))
(assert-true (string-contains? html "content"))))
(deftest "class attribute"
(let ((html (render-html "(div :class \"foo bar\" \"x\")")))
(assert-true (string-contains? html "class=\"foo bar\""))))
(deftest "multiple attributes"
(let ((html (render-html "(a :href \"/home\" :class \"link\" \"Home\")")))
(assert-true (string-contains? html "href=\"/home\""))
(assert-true (string-contains? html "class=\"link\""))
(assert-true (string-contains? html "Home")))))
;; --------------------------------------------------------------------------
;; Void elements
;; --------------------------------------------------------------------------
(defsuite "render-void"
(deftest "br is self-closing"
(assert-equal "<br />" (render-html "(br)")))
(deftest "img with attrs"
(let ((html (render-html "(img :src \"pic.jpg\" :alt \"A pic\")")))
(assert-true (string-contains? html "<img"))
(assert-true (string-contains? html "src=\"pic.jpg\""))
(assert-true (string-contains? html "/>"))
;; void elements should not have a closing tag
(assert-false (string-contains? html "</img>"))))
(deftest "input is self-closing"
(let ((html (render-html "(input :type \"text\" :name \"q\")")))
(assert-true (string-contains? html "<input"))
(assert-true (string-contains? html "/>")))))
;; --------------------------------------------------------------------------
;; Boolean attributes
;; --------------------------------------------------------------------------
(defsuite "render-boolean-attrs"
(deftest "true boolean attr emits name only"
(let ((html (render-html "(input :disabled true :type \"text\")")))
(assert-true (string-contains? html "disabled"))
;; Should NOT have disabled="true"
(assert-false (string-contains? html "disabled=\""))))
(deftest "false boolean attr omitted"
(let ((html (render-html "(input :disabled false :type \"text\")")))
(assert-false (string-contains? html "disabled")))))
;; --------------------------------------------------------------------------
;; Fragments
;; --------------------------------------------------------------------------
(defsuite "render-fragments"
(deftest "fragment renders children without wrapper"
(assert-equal "<p>a</p><p>b</p>"
(render-html "(<> (p \"a\") (p \"b\"))")))
(deftest "empty fragment"
(assert-equal ""
(render-html "(<>)"))))
;; --------------------------------------------------------------------------
;; HTML escaping
;; --------------------------------------------------------------------------
(defsuite "render-escaping"
(deftest "text content is escaped"
(let ((html (render-html "(p \"<script>alert(1)</script>\")")))
(assert-false (string-contains? html "<script>"))
(assert-true (string-contains? html "&lt;script&gt;"))))
(deftest "attribute values are escaped"
(let ((html (render-html "(div :title \"a\\\"b\" \"x\")")))
(assert-true (string-contains? html "title=")))))
;; --------------------------------------------------------------------------
;; Control flow in render context
;; --------------------------------------------------------------------------
(defsuite "render-control-flow"
(deftest "if renders correct branch"
(assert-equal "<p>yes</p>"
(render-html "(if true (p \"yes\") (p \"no\"))"))
(assert-equal "<p>no</p>"
(render-html "(if false (p \"yes\") (p \"no\"))")))
(deftest "when renders or skips"
(assert-equal "<p>ok</p>"
(render-html "(when true (p \"ok\"))"))
(assert-equal ""
(render-html "(when false (p \"ok\"))")))
(deftest "map renders list"
(assert-equal "<li>1</li><li>2</li><li>3</li>"
(render-html "(map (fn (x) (li x)) (list 1 2 3))")))
(deftest "let in render context"
(assert-equal "<p>hello</p>"
(render-html "(let ((x \"hello\")) (p x))")))
(deftest "cond with 2-element predicate test"
;; Regression: cond misclassifies (nil? x) as scheme-style clause.
(assert-equal "<p>yes</p>"
(render-html "(cond (nil? nil) (p \"yes\") :else (p \"no\"))"))
(assert-equal "<p>no</p>"
(render-html "(cond (nil? \"x\") (p \"yes\") :else (p \"no\"))")))
(deftest "let preserves outer scope bindings"
;; Regression: process-bindings must preserve parent env scope chain.
;; Using merge() on Env objects returns empty dict (Env is not dict subclass).
(assert-equal "<p>outer</p>"
(render-html "(do (define theme \"outer\") (let ((x 1)) (p theme)))")))
(deftest "nested let preserves outer scope"
(assert-equal "<div><span>hello</span><span>world</span></div>"
(render-html "(do (define a \"hello\")
(define b \"world\")
(div (let ((x 1)) (span a))
(let ((y 2)) (span b))))"))))
;; --------------------------------------------------------------------------
;; Component rendering
;; --------------------------------------------------------------------------
(defsuite "render-components"
(deftest "component with keyword args"
(assert-equal "<h1>Hello</h1>"
(render-html "(do (defcomp ~title (&key text) (h1 text)) (~title :text \"Hello\"))")))
(deftest "component with children"
(let ((html (render-html "(do (defcomp ~box (&key &rest children) (div :class \"box\" children)) (~box (p \"inside\")))")))
(assert-true (string-contains? html "class=\"box\""))
(assert-true (string-contains? html "<p>inside</p>")))))
;; --------------------------------------------------------------------------
;; Map/filter producing multiple children (aser-adjacent regression tests)
;; --------------------------------------------------------------------------
(defsuite "render-map-children"
(deftest "map producing multiple children inside tag"
(assert-equal "<ul><li>a</li><li>b</li><li>c</li></ul>"
(render-html "(do (define items (list \"a\" \"b\" \"c\"))
(ul (map (fn (x) (li x)) items)))")))
(deftest "map with other siblings"
(assert-equal "<ul><li>first</li><li>a</li><li>b</li></ul>"
(render-html "(do (define items (list \"a\" \"b\"))
(ul (li \"first\") (map (fn (x) (li x)) items)))")))
(deftest "filter with nil results inside tag"
(assert-equal "<ul><li>a</li><li>c</li></ul>"
(render-html "(do (define items (list \"a\" nil \"c\"))
(ul (map (fn (x) (li x))
(filter (fn (x) (not (nil? x))) items))))")))
(deftest "nested map inside let"
(assert-equal "<div><span>1</span><span>2</span></div>"
(render-html "(let ((nums (list 1 2)))
(div (map (fn (n) (span n)) nums)))")))
(deftest "component with &rest receiving mapped results"
(let ((html (render-html "(do (defcomp ~list-box (&key &rest children) (div :class \"lb\" children))
(define items (list \"x\" \"y\"))
(~list-box (map (fn (x) (p x)) items)))")))
(assert-true (string-contains? html "class=\"lb\""))
(assert-true (string-contains? html "<p>x</p>"))
(assert-true (string-contains? html "<p>y</p>"))))
(deftest "map-indexed renders with index"
(assert-equal "<li>0: a</li><li>1: b</li>"
(render-html "(map-indexed (fn (i x) (li (str i \": \" x))) (list \"a\" \"b\"))")))
(deftest "for-each renders each item"
(assert-equal "<p>1</p><p>2</p>"
(render-html "(for-each (fn (x) (p x)) (list 1 2))"))))

652
spec/test-types.sx
View File

@@ -1,652 +0,0 @@
;; ==========================================================================
;; test-types.sx — Tests for the SX gradual type system
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: types.sx (subtype?, infer-type, check-component, etc.)
;;
;; Platform functions required (beyond test framework):
;; All type system functions from types.sx must be loaded.
;; test-prim-types — a dict of primitive return types for testing.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Subtype checking
;; --------------------------------------------------------------------------
(defsuite "subtype-basics"
(deftest "any accepts everything"
(assert-true (subtype? "number" "any"))
(assert-true (subtype? "string" "any"))
(assert-true (subtype? "nil" "any"))
(assert-true (subtype? "boolean" "any"))
(assert-true (subtype? "any" "any")))
(deftest "never is subtype of everything"
(assert-true (subtype? "never" "number"))
(assert-true (subtype? "never" "string"))
(assert-true (subtype? "never" "any"))
(assert-true (subtype? "never" "nil")))
(deftest "identical types"
(assert-true (subtype? "number" "number"))
(assert-true (subtype? "string" "string"))
(assert-true (subtype? "boolean" "boolean"))
(assert-true (subtype? "nil" "nil")))
(deftest "different base types are not subtypes"
(assert-false (subtype? "number" "string"))
(assert-false (subtype? "string" "number"))
(assert-false (subtype? "boolean" "number"))
(assert-false (subtype? "string" "boolean")))
(deftest "any is not subtype of specific type"
(assert-false (subtype? "any" "number"))
(assert-false (subtype? "any" "string"))))
(defsuite "subtype-nullable"
(deftest "nil is subtype of nullable types"
(assert-true (subtype? "nil" "string?"))
(assert-true (subtype? "nil" "number?"))
(assert-true (subtype? "nil" "dict?"))
(assert-true (subtype? "nil" "boolean?")))
(deftest "base is subtype of its nullable"
(assert-true (subtype? "string" "string?"))
(assert-true (subtype? "number" "number?"))
(assert-true (subtype? "dict" "dict?")))
(deftest "nullable is not subtype of base"
(assert-false (subtype? "string?" "string"))
(assert-false (subtype? "number?" "number")))
(deftest "different nullable types are not subtypes"
(assert-false (subtype? "number" "string?"))
(assert-false (subtype? "string" "number?"))))
(defsuite "subtype-unions"
(deftest "member is subtype of union"
(assert-true (subtype? "number" (list "or" "number" "string")))
(assert-true (subtype? "string" (list "or" "number" "string"))))
(deftest "non-member is not subtype of union"
(assert-false (subtype? "boolean" (list "or" "number" "string"))))
(deftest "union is subtype if all members are"
(assert-true (subtype? (list "or" "number" "string")
(list "or" "number" "string" "boolean")))
(assert-true (subtype? (list "or" "number" "string") "any")))
(deftest "union is not subtype if any member is not"
(assert-false (subtype? (list "or" "number" "string") "number"))))
(defsuite "subtype-list-of"
(deftest "list-of covariance"
(assert-true (subtype? (list "list-of" "number") (list "list-of" "number")))
(assert-true (subtype? (list "list-of" "number") (list "list-of" "any"))))
(deftest "list-of is subtype of list"
(assert-true (subtype? (list "list-of" "number") "list")))
(deftest "list is subtype of list-of any"
(assert-true (subtype? "list" (list "list-of" "any")))))
;; --------------------------------------------------------------------------
;; Type union
;; --------------------------------------------------------------------------
(defsuite "type-union"
(deftest "same types"
(assert-equal "number" (type-union "number" "number"))
(assert-equal "string" (type-union "string" "string")))
(deftest "any absorbs"
(assert-equal "any" (type-union "any" "number"))
(assert-equal "any" (type-union "number" "any")))
(deftest "never is identity"
(assert-equal "number" (type-union "never" "number"))
(assert-equal "string" (type-union "string" "never")))
(deftest "nil + base creates nullable"
(assert-equal "string?" (type-union "nil" "string"))
(assert-equal "number?" (type-union "number" "nil")))
(deftest "subtype collapses"
(assert-equal "string?" (type-union "string" "string?"))
(assert-equal "string?" (type-union "string?" "string")))
(deftest "incompatible creates union"
(let ((result (type-union "number" "string")))
(assert-true (= (type-of result) "list"))
(assert-equal "or" (first result))
(assert-true (contains? result "number"))
(assert-true (contains? result "string")))))
;; --------------------------------------------------------------------------
;; Type narrowing
;; --------------------------------------------------------------------------
(defsuite "type-narrowing"
(deftest "nil? narrows to nil in then branch"
(let ((result (narrow-type "string?" "nil?")))
(assert-equal "nil" (first result))
(assert-equal "string" (nth result 1))))
(deftest "nil? narrows any stays any"
(let ((result (narrow-type "any" "nil?")))
(assert-equal "nil" (first result))
(assert-equal "any" (nth result 1))))
(deftest "string? narrows to string in then branch"
(let ((result (narrow-type "any" "string?")))
(assert-equal "string" (first result))
;; else branch — can't narrow any
(assert-equal "any" (nth result 1))))
(deftest "nil? on nil type narrows to never in else"
(let ((result (narrow-type "nil" "nil?")))
(assert-equal "nil" (first result))
(assert-equal "never" (nth result 1)))))
;; --------------------------------------------------------------------------
;; Type inference
;; --------------------------------------------------------------------------
(defsuite "infer-literals"
(deftest "number literal"
(assert-equal "number" (infer-type 42 (dict) (test-prim-types))))
(deftest "string literal"
(assert-equal "string" (infer-type "hello" (dict) (test-prim-types))))
(deftest "boolean literal"
(assert-equal "boolean" (infer-type true (dict) (test-prim-types))))
(deftest "nil"
(assert-equal "nil" (infer-type nil (dict) (test-prim-types)))))
(defsuite "infer-calls"
(deftest "known primitive return type"
;; (+ 1 2) → number
(let ((expr (sx-parse "(+ 1 2)")))
(assert-equal "number"
(infer-type (first expr) (dict) (test-prim-types)))))
(deftest "str returns string"
(let ((expr (sx-parse "(str 1 2)")))
(assert-equal "string"
(infer-type (first expr) (dict) (test-prim-types)))))
(deftest "comparison returns boolean"
(let ((expr (sx-parse "(= 1 2)")))
(assert-equal "boolean"
(infer-type (first expr) (dict) (test-prim-types)))))
(deftest "component call returns element"
(let ((expr (sx-parse "(~card :title \"hi\")")))
(assert-equal "element"
(infer-type (first expr) (dict) (test-prim-types)))))
(deftest "unknown function returns any"
(let ((expr (sx-parse "(unknown-fn 1 2)")))
(assert-equal "any"
(infer-type (first expr) (dict) (test-prim-types))))))
(defsuite "infer-special-forms"
(deftest "if produces union of branches"
(let ((expr (sx-parse "(if true 42 \"hello\")")))
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
;; number | string — should be a union
(assert-true (or (= t (list "or" "number" "string"))
(= t "any"))))))
(deftest "if with no else includes nil"
(let ((expr (sx-parse "(if true 42)")))
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
(assert-equal "number?" t))))
(deftest "when includes nil"
(let ((expr (sx-parse "(when true 42)")))
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
(assert-equal "number?" t))))
(deftest "do returns last type"
(let ((expr (sx-parse "(do 1 2 \"hello\")")))
(assert-equal "string"
(infer-type (first expr) (dict) (test-prim-types)))))
(deftest "let infers binding types"
(let ((expr (sx-parse "(let ((x 42)) x)")))
(assert-equal "number"
(infer-type (first expr) (dict) (test-prim-types)))))
(deftest "lambda returns lambda"
(let ((expr (sx-parse "(fn (x) (+ x 1))")))
(assert-equal "lambda"
(infer-type (first expr) (dict) (test-prim-types))))))
;; --------------------------------------------------------------------------
;; Component call checking
;; --------------------------------------------------------------------------
(defsuite "check-component-calls"
(deftest "type mismatch produces error"
;; Create a component with typed params, then check a bad call
(let ((env (test-env)))
;; Define a typed component
(do
(define dummy-env env)
(defcomp ~typed-card (&key title price) (div title price))
(component-set-param-types! ~typed-card
{:title "string" :price "number"}))
;; Check a call with wrong type
(let ((diagnostics
(check-component-call "~typed-card" ~typed-card
(rest (first (sx-parse "(~typed-card :title 42 :price \"bad\")")))
(dict) (test-prim-types))))
(assert-true (> (len diagnostics) 0))
(assert-equal "error" (dict-get (first diagnostics) "level")))))
(deftest "correct call produces no errors"
(let ((env (test-env)))
(do
(define dummy-env env)
(defcomp ~ok-card (&key title price) (div title price))
(component-set-param-types! ~ok-card
{:title "string" :price "number"}))
(let ((diagnostics
(check-component-call "~ok-card" ~ok-card
(rest (first (sx-parse "(~ok-card :title \"hi\" :price 42)")))
(dict) (test-prim-types))))
(assert-equal 0 (len diagnostics)))))
(deftest "unknown kwarg produces warning"
(let ((env (test-env)))
(do
(define dummy-env env)
(defcomp ~warn-card (&key title) (div title))
(component-set-param-types! ~warn-card
{:title "string"}))
(let ((diagnostics
(check-component-call "~warn-card" ~warn-card
(rest (first (sx-parse "(~warn-card :title \"hi\" :colour \"red\")")))
(dict) (test-prim-types))))
(assert-true (> (len diagnostics) 0))
(assert-equal "warning" (dict-get (first diagnostics) "level"))))))
;; --------------------------------------------------------------------------
;; Annotation syntax: (name :as type) in defcomp params
;; --------------------------------------------------------------------------
(defsuite "typed-defcomp"
(deftest "typed params are parsed and stored"
(let ((env (test-env)))
(defcomp ~typed-widget (&key (title :as string) (count :as number)) (div title count))
(let ((pt (component-param-types ~typed-widget)))
(assert-true (not (nil? pt)))
(assert-equal "string" (dict-get pt "title"))
(assert-equal "number" (dict-get pt "count")))))
(deftest "mixed typed and untyped params"
(let ((env (test-env)))
(defcomp ~mixed-widget (&key (title :as string) subtitle) (div title subtitle))
(let ((pt (component-param-types ~mixed-widget)))
(assert-true (not (nil? pt)))
(assert-equal "string" (dict-get pt "title"))
;; subtitle has no annotation — should not be in param-types
(assert-false (has-key? pt "subtitle")))))
(deftest "untyped defcomp has nil param-types"
(let ((env (test-env)))
(defcomp ~plain-widget (&key title subtitle) (div title subtitle))
(assert-true (nil? (component-param-types ~plain-widget)))))
(deftest "typed component catches type error on call"
(let ((env (test-env)))
(defcomp ~strict-card (&key (title :as string) (price :as number)) (div title price))
;; Call with wrong types
(let ((diagnostics
(check-component-call "~strict-card" ~strict-card
(rest (first (sx-parse "(~strict-card :title 42 :price \"bad\")")))
(dict) (test-prim-types))))
;; Should have errors for both wrong-type args
(assert-true (>= (len diagnostics) 1))
(assert-equal "error" (dict-get (first diagnostics) "level")))))
(deftest "typed component passes correct call"
(let ((env (test-env)))
(defcomp ~ok-widget (&key (name :as string) (age :as number)) (div name age))
(let ((diagnostics
(check-component-call "~ok-widget" ~ok-widget
(rest (first (sx-parse "(~ok-widget :name \"Alice\" :age 30)")))
(dict) (test-prim-types))))
(assert-equal 0 (len diagnostics)))))
(deftest "nullable type accepts nil"
(let ((env (test-env)))
(defcomp ~nullable-widget (&key (title :as string) (subtitle :as string?)) (div title subtitle))
;; Passing nil for nullable param should be fine
(let ((diagnostics
(check-component-call "~nullable-widget" ~nullable-widget
(rest (first (sx-parse "(~nullable-widget :title \"hi\" :subtitle nil)")))
(dict) (test-prim-types))))
(assert-equal 0 (len diagnostics))))))
;; --------------------------------------------------------------------------
;; Primitive call checking (Phase 5)
;; --------------------------------------------------------------------------
(defsuite "check-primitive-calls"
(deftest "correct types produce no errors"
(let ((ppt (test-prim-param-types)))
(let ((diagnostics
(check-primitive-call "+" (rest (first (sx-parse "(+ 1 2 3)")))
(dict) (test-prim-types) ppt nil)))
(assert-equal 0 (len diagnostics)))))
(deftest "string arg to numeric primitive produces error"
(let ((ppt (test-prim-param-types)))
(let ((diagnostics
(check-primitive-call "+" (rest (first (sx-parse "(+ 1 \"hello\")")))
(dict) (test-prim-types) ppt nil)))
(assert-true (> (len diagnostics) 0))
(assert-equal "error" (get (first diagnostics) "level")))))
(deftest "number arg to string primitive produces error"
(let ((ppt (test-prim-param-types)))
(let ((diagnostics
(check-primitive-call "upper" (rest (first (sx-parse "(upper 42)")))
(dict) (test-prim-types) ppt nil)))
(assert-true (> (len diagnostics) 0))
(assert-equal "error" (get (first diagnostics) "level")))))
(deftest "positional and rest params both checked"
;; (- "bad" 1) — first positional arg is string, expects number
(let ((ppt (test-prim-param-types)))
(let ((diagnostics
(check-primitive-call "-" (rest (first (sx-parse "(- \"bad\" 1)")))
(dict) (test-prim-types) ppt nil)))
(assert-true (> (len diagnostics) 0)))))
(deftest "dict arg to keys is valid"
(let ((ppt (test-prim-param-types)))
(let ((diagnostics
(check-primitive-call "keys" (rest (first (sx-parse "(keys {:a 1})")))
(dict) (test-prim-types) ppt nil)))
(assert-equal 0 (len diagnostics)))))
(deftest "number arg to keys produces error"
(let ((ppt (test-prim-param-types)))
(let ((diagnostics
(check-primitive-call "keys" (rest (first (sx-parse "(keys 42)")))
(dict) (test-prim-types) ppt nil)))
(assert-true (> (len diagnostics) 0)))))
(deftest "variable with known type passes check"
;; Variable n is known to be number in type-env
(let ((ppt (test-prim-param-types))
(tenv {"n" "number"}))
(let ((diagnostics
(check-primitive-call "inc" (rest (first (sx-parse "(inc n)")))
tenv (test-prim-types) ppt nil)))
(assert-equal 0 (len diagnostics)))))
(deftest "variable with wrong type fails check"
;; Variable s is known to be string in type-env
(let ((ppt (test-prim-param-types))
(tenv {"s" "string"}))
(let ((diagnostics
(check-primitive-call "inc" (rest (first (sx-parse "(inc s)")))
tenv (test-prim-types) ppt nil)))
(assert-true (> (len diagnostics) 0)))))
(deftest "any-typed variable skips check"
;; Variable x has type any — should not produce errors
(let ((ppt (test-prim-param-types))
(tenv {"x" "any"}))
(let ((diagnostics
(check-primitive-call "upper" (rest (first (sx-parse "(upper x)")))
tenv (test-prim-types) ppt nil)))
(assert-equal 0 (len diagnostics)))))
(deftest "body-walk catches primitive errors in component"
;; Manually build a component and check it via check-body-walk directly
(let ((ppt (test-prim-param-types))
(body (first (sx-parse "(div (+ name 1))")))
(type-env {"name" "string"})
(diagnostics (list)))
(check-body-walk body "~bad-math" type-env (test-prim-types) ppt (test-env) diagnostics nil nil)
(assert-true (> (len diagnostics) 0))
(assert-equal "error" (get (first diagnostics) "level")))))
;; --------------------------------------------------------------------------
;; deftype — type aliases
;; --------------------------------------------------------------------------
(defsuite "deftype-alias"
(deftest "simple alias resolves"
(let ((registry {"price" {:name "price" :params () :body "number"}}))
(assert-equal "number" (resolve-type "price" registry))))
(deftest "alias chain resolves"
(let ((registry {"price" {:name "price" :params () :body "number"}
"cost" {:name "cost" :params () :body "price"}}))
(assert-equal "number" (resolve-type "cost" registry))))
(deftest "unknown type passes through"
(let ((registry {"price" {:name "price" :params () :body "number"}}))
(assert-equal "string" (resolve-type "string" registry))))
(deftest "subtype-resolved? works through alias"
(let ((registry {"price" {:name "price" :params () :body "number"}}))
(assert-true (subtype-resolved? "price" "number" registry))
(assert-true (subtype-resolved? "number" "price" registry)))))
;; --------------------------------------------------------------------------
;; deftype — union types
;; --------------------------------------------------------------------------
(defsuite "deftype-union"
(deftest "union resolves"
(let ((registry {"status" {:name "status" :params () :body ("or" "string" "number")}}))
(let ((resolved (resolve-type "status" registry)))
(assert-true (= (type-of resolved) "list"))
(assert-equal "or" (first resolved)))))
(deftest "subtype through named union"
(let ((registry {"status" {:name "status" :params () :body ("or" "string" "number")}}))
(assert-true (subtype-resolved? "string" "status" registry))
(assert-true (subtype-resolved? "number" "status" registry))
(assert-false (subtype-resolved? "boolean" "status" registry)))))
;; --------------------------------------------------------------------------
;; deftype — record types
;; --------------------------------------------------------------------------
(defsuite "deftype-record"
(deftest "record resolves to dict"
(let ((registry {"card-props" {:name "card-props" :params ()
:body {"title" "string" "price" "number"}}}))
(let ((resolved (resolve-type "card-props" registry)))
(assert-equal "dict" (type-of resolved))
(assert-equal "string" (get resolved "title"))
(assert-equal "number" (get resolved "price")))))
(deftest "record structural subtyping"
(let ((registry {"card-props" {:name "card-props" :params ()
:body {"title" "string" "price" "number"}}
"titled" {:name "titled" :params ()
:body {"title" "string"}}}))
;; card-props has title+price, titled has just title
;; card-props <: titled (has all required fields)
(assert-true (subtype-resolved? "card-props" "titled" registry))))
(deftest "get infers field type from record"
(let ((registry {"card-props" {:name "card-props" :params ()
:body {"title" "string" "price" "number"}}})
(type-env {"d" "card-props"})
(expr (first (sx-parse "(get d :title)"))))
(assert-equal "string"
(infer-type expr type-env (test-prim-types) registry)))))
;; --------------------------------------------------------------------------
;; deftype — parameterized types
;; --------------------------------------------------------------------------
(defsuite "deftype-parameterized"
(deftest "maybe instantiation"
(let ((registry {"maybe" {:name "maybe" :params ("a")
:body ("or" "a" "nil")}}))
(let ((resolved (resolve-type (list "maybe" "string") registry)))
(assert-true (= (type-of resolved) "list"))
(assert-equal "or" (first resolved))
(assert-true (contains? resolved "string"))
(assert-true (contains? resolved "nil")))))
(deftest "subtype through parameterized type"
(let ((registry {"maybe" {:name "maybe" :params ("a")
:body ("or" "a" "nil")}}))
(assert-true (subtype-resolved? "string" (list "maybe" "string") registry))
(assert-true (subtype-resolved? "nil" (list "maybe" "string") registry))
(assert-false (subtype-resolved? "number" (list "maybe" "string") registry))))
(deftest "substitute-type-vars works"
(let ((result (substitute-type-vars ("or" "a" "nil") (list "a") (list "number"))))
(assert-equal "or" (first result))
(assert-true (contains? result "number"))
(assert-true (contains? result "nil")))))
;; --------------------------------------------------------------------------
;; defeffect — effect basics
;; --------------------------------------------------------------------------
(defsuite "defeffect-basics"
(deftest "get-effects returns nil for unannotated"
(let ((anns {"fetch" ("io")}))
(assert-true (nil? (get-effects "unknown" anns)))))
(deftest "get-effects returns effects for annotated"
(let ((anns {"fetch" ("io")}))
(assert-equal (list "io") (get-effects "fetch" anns))))
(deftest "nil annotations returns nil"
(assert-true (nil? (get-effects "anything" nil)))))
;; --------------------------------------------------------------------------
;; defeffect — effect checking
;; --------------------------------------------------------------------------
(defsuite "effect-checking"
(deftest "pure cannot call io"
(let ((anns {"~pure-comp" () "fetch" ("io")}))
(let ((diagnostics (check-effect-call "fetch" (list) anns "~pure-comp")))
(assert-true (> (len diagnostics) 0))
(assert-equal "error" (get (first diagnostics) "level")))))
(deftest "io context allows io"
(let ((anns {"~io-comp" ("io") "fetch" ("io")}))
(let ((diagnostics (check-effect-call "fetch" (list "io") anns "~io-comp")))
(assert-equal 0 (len diagnostics)))))
(deftest "unannotated caller allows everything"
(let ((anns {"fetch" ("io")}))
(let ((diagnostics (check-effect-call "fetch" nil anns "~unknown")))
(assert-equal 0 (len diagnostics)))))
(deftest "unannotated callee skips check"
(let ((anns {"~pure-comp" ()}))
(let ((diagnostics (check-effect-call "unknown-fn" (list) anns "~pure-comp")))
(assert-equal 0 (len diagnostics))))))
;; --------------------------------------------------------------------------
;; defeffect — subset checking
;; --------------------------------------------------------------------------
(defsuite "effect-subset"
(deftest "empty is subset of anything"
(assert-true (effects-subset? (list) (list "io")))
(assert-true (effects-subset? (list) (list))))
(deftest "io is subset of io"
(assert-true (effects-subset? (list "io") (list "io" "async"))))
(deftest "io is not subset of pure"
(assert-false (effects-subset? (list "io") (list))))
(deftest "nil callee skips check"
(assert-true (effects-subset? nil (list))))
(deftest "nil caller allows all"
(assert-true (effects-subset? (list "io") nil))))
;; --------------------------------------------------------------------------
;; build-effect-annotations
;; --------------------------------------------------------------------------
(defsuite "build-effect-annotations"
(deftest "builds annotations from io declarations"
(let ((decls (list {"name" "fetch"} {"name" "save!"}))
(anns (build-effect-annotations decls)))
(assert-equal (list "io") (get anns "fetch"))
(assert-equal (list "io") (get anns "save!"))))
(deftest "skips entries without name"
(let ((decls (list {"name" "fetch"} {"other" "x"}))
(anns (build-effect-annotations decls)))
(assert-true (has-key? anns "fetch"))
(assert-false (has-key? anns "other"))))
(deftest "empty declarations produce empty dict"
(let ((anns (build-effect-annotations (list))))
(assert-equal 0 (len (keys anns))))))
;; --------------------------------------------------------------------------
;; check-component-effects
;; --------------------------------------------------------------------------
;; Define test components at top level so they're in the main env
(defcomp ~eff-pure-card () :effects []
(div (fetch "url")))
(defcomp ~eff-io-card () :effects [io]
(div (fetch "url")))
(defcomp ~eff-unannot-card ()
(div (fetch "url")))
(defsuite "check-component-effects"
(deftest "pure component calling io produces diagnostic"
(let ((anns {"~eff-pure-card" () "fetch" ("io")})
(diagnostics (check-component-effects "~eff-pure-card" (test-env) anns)))
(assert-true (> (len diagnostics) 0))))
(deftest "io component calling io produces no diagnostic"
(let ((anns {"~eff-io-card" ("io") "fetch" ("io")})
(diagnostics (check-component-effects "~eff-io-card" (test-env) anns)))
(assert-equal 0 (len diagnostics))))
(deftest "unannotated component skips check"
(let ((anns {"fetch" ("io")})
(diagnostics (check-component-effects "~eff-unannot-card" (test-env) anns)))
(assert-equal 0 (len diagnostics)))))

602
spec/test.sx
View File

@@ -1,602 +0,0 @@
;; ==========================================================================
;; test.sx — Self-hosting SX test suite (backward-compatible entry point)
;;
;; This file includes the test framework and core eval tests inline.
;; It exists for backward compatibility — runners that load "test.sx"
;; get the same 81 tests as before.
;;
;; For modular testing, runners should instead load:
;; 1. test-framework.sx (macros + assertions)
;; 2. One or more test specs: test-eval.sx, test-parser.sx,
;; test-router.sx, test-render.sx, etc.
;;
;; Platform functions required:
;; try-call (thunk) -> {:ok true} | {:ok false :error "msg"}
;; report-pass (name) -> platform-specific pass output
;; report-fail (name error) -> platform-specific fail output
;; push-suite (name) -> push suite name onto context stack
;; pop-suite () -> pop suite name from context stack
;;
;; Usage:
;; ;; Host injects platform functions into env, then:
;; (eval-file "test.sx" env)
;;
;; The same test.sx runs on every host — Python, JavaScript, etc.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Test framework macros
;; --------------------------------------------------------------------------
;;
;; deftest and defsuite are macros that make test.sx directly executable.
;; The host provides try-call (error catching), reporting, and suite
;; context — everything else is pure SX.
(defmacro deftest (name &rest body)
`(let ((result (try-call (fn () ,@body))))
(if (get result "ok")
(report-pass ,name)
(report-fail ,name (get result "error")))))
(defmacro defsuite (name &rest items)
`(do (push-suite ,name)
,@items
(pop-suite)))
;; --------------------------------------------------------------------------
;; 2. Assertion helpers — defined in SX, available in test bodies
;; --------------------------------------------------------------------------
;;
;; These are regular functions (not special forms). They use the `assert`
;; primitive underneath but provide better error messages.
(define assert-equal
(fn (expected actual)
(assert (equal? expected actual)
(str "Expected " (str expected) " but got " (str actual)))))
(define assert-not-equal
(fn (a b)
(assert (not (equal? a b))
(str "Expected values to differ but both are " (str a)))))
(define assert-true
(fn (val)
(assert val (str "Expected truthy but got " (str val)))))
(define assert-false
(fn (val)
(assert (not val) (str "Expected falsy but got " (str val)))))
(define assert-nil
(fn (val)
(assert (nil? val) (str "Expected nil but got " (str val)))))
(define assert-type
(fn (expected-type val)
;; Implemented via predicate dispatch since type-of is a platform
;; function not available in all hosts. Uses nested if to avoid
;; Scheme-style cond detection for 2-element predicate calls.
;; Boolean checked before number (subtypes on some platforms).
(let ((actual-type
(if (nil? val) "nil"
(if (boolean? val) "boolean"
(if (number? val) "number"
(if (string? val) "string"
(if (list? val) "list"
(if (dict? val) "dict"
"unknown"))))))))
(assert (= expected-type actual-type)
(str "Expected type " expected-type " but got " actual-type)))))
(define assert-length
(fn (expected-len col)
(assert (= (len col) expected-len)
(str "Expected length " expected-len " but got " (len col)))))
(define assert-contains
(fn (item col)
(assert (some (fn (x) (equal? x item)) col)
(str "Expected collection to contain " (str item)))))
(define assert-throws
(fn (thunk)
(let ((result (try-call thunk)))
(assert (not (get result "ok"))
"Expected an error to be thrown but none was"))))
;; ==========================================================================
;; 3. Test suites — SX testing SX
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 3a. Literals and types
;; --------------------------------------------------------------------------
(defsuite "literals"
(deftest "numbers are numbers"
(assert-type "number" 42)
(assert-type "number" 3.14)
(assert-type "number" -1))
(deftest "strings are strings"
(assert-type "string" "hello")
(assert-type "string" ""))
(deftest "booleans are booleans"
(assert-type "boolean" true)
(assert-type "boolean" false))
(deftest "nil is nil"
(assert-type "nil" nil)
(assert-nil nil))
(deftest "lists are lists"
(assert-type "list" (list 1 2 3))
(assert-type "list" (list)))
(deftest "dicts are dicts"
(assert-type "dict" {:a 1 :b 2})))
;; --------------------------------------------------------------------------
;; 3b. Arithmetic
;; --------------------------------------------------------------------------
(defsuite "arithmetic"
(deftest "addition"
(assert-equal 3 (+ 1 2))
(assert-equal 0 (+ 0 0))
(assert-equal -1 (+ 1 -2))
(assert-equal 10 (+ 1 2 3 4)))
(deftest "subtraction"
(assert-equal 1 (- 3 2))
(assert-equal -1 (- 2 3)))
(deftest "multiplication"
(assert-equal 6 (* 2 3))
(assert-equal 0 (* 0 100))
(assert-equal 24 (* 1 2 3 4)))
(deftest "division"
(assert-equal 2 (/ 6 3))
(assert-equal 2.5 (/ 5 2)))
(deftest "modulo"
(assert-equal 1 (mod 7 3))
(assert-equal 0 (mod 6 3))))
;; --------------------------------------------------------------------------
;; 3c. Comparison
;; --------------------------------------------------------------------------
(defsuite "comparison"
(deftest "equality"
(assert-true (= 1 1))
(assert-false (= 1 2))
(assert-true (= "a" "a"))
(assert-false (= "a" "b")))
(deftest "deep equality"
(assert-true (equal? (list 1 2 3) (list 1 2 3)))
(assert-false (equal? (list 1 2) (list 1 3)))
(assert-true (equal? {:a 1} {:a 1}))
(assert-false (equal? {:a 1} {:a 2})))
(deftest "ordering"
(assert-true (< 1 2))
(assert-false (< 2 1))
(assert-true (> 2 1))
(assert-true (<= 1 1))
(assert-true (<= 1 2))
(assert-true (>= 2 2))
(assert-true (>= 3 2))))
;; --------------------------------------------------------------------------
;; 3d. String operations
;; --------------------------------------------------------------------------
(defsuite "strings"
(deftest "str concatenation"
(assert-equal "abc" (str "a" "b" "c"))
(assert-equal "hello world" (str "hello" " " "world"))
(assert-equal "42" (str 42))
(assert-equal "" (str)))
(deftest "string-length"
(assert-equal 5 (string-length "hello"))
(assert-equal 0 (string-length "")))
(deftest "substring"
(assert-equal "ell" (substring "hello" 1 4))
(assert-equal "hello" (substring "hello" 0 5)))
(deftest "string-contains?"
(assert-true (string-contains? "hello world" "world"))
(assert-false (string-contains? "hello" "xyz")))
(deftest "upcase and downcase"
(assert-equal "HELLO" (upcase "hello"))
(assert-equal "hello" (downcase "HELLO")))
(deftest "trim"
(assert-equal "hello" (trim " hello "))
(assert-equal "hello" (trim "hello")))
(deftest "split and join"
(assert-equal (list "a" "b" "c") (split "a,b,c" ","))
(assert-equal "a-b-c" (join "-" (list "a" "b" "c")))))
;; --------------------------------------------------------------------------
;; 3e. List operations
;; --------------------------------------------------------------------------
(defsuite "lists"
(deftest "constructors"
(assert-equal (list 1 2 3) (list 1 2 3))
(assert-equal (list) (list))
(assert-length 3 (list 1 2 3)))
(deftest "first and rest"
(assert-equal 1 (first (list 1 2 3)))
(assert-equal (list 2 3) (rest (list 1 2 3)))
(assert-nil (first (list)))
(assert-equal (list) (rest (list))))
(deftest "nth"
(assert-equal 1 (nth (list 1 2 3) 0))
(assert-equal 2 (nth (list 1 2 3) 1))
(assert-equal 3 (nth (list 1 2 3) 2)))
(deftest "last"
(assert-equal 3 (last (list 1 2 3)))
(assert-nil (last (list))))
(deftest "cons and append"
(assert-equal (list 0 1 2) (cons 0 (list 1 2)))
(assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4))))
(deftest "reverse"
(assert-equal (list 3 2 1) (reverse (list 1 2 3)))
(assert-equal (list) (reverse (list))))
(deftest "empty?"
(assert-true (empty? (list)))
(assert-false (empty? (list 1))))
(deftest "len"
(assert-equal 0 (len (list)))
(assert-equal 3 (len (list 1 2 3))))
(deftest "contains?"
(assert-true (contains? (list 1 2 3) 2))
(assert-false (contains? (list 1 2 3) 4)))
(deftest "flatten"
(assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4))))))
;; --------------------------------------------------------------------------
;; 3f. Dict operations
;; --------------------------------------------------------------------------
(defsuite "dicts"
(deftest "dict literal"
(assert-type "dict" {:a 1 :b 2})
(assert-equal 1 (get {:a 1} "a"))
(assert-equal 2 (get {:a 1 :b 2} "b")))
(deftest "assoc"
(assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2))
(assert-equal {:a 99} (assoc {:a 1} "a" 99)))
(deftest "dissoc"
(assert-equal {:b 2} (dissoc {:a 1 :b 2} "a")))
(deftest "keys and vals"
(let ((d {:a 1 :b 2}))
(assert-length 2 (keys d))
(assert-length 2 (vals d))
(assert-contains "a" (keys d))
(assert-contains "b" (keys d))))
(deftest "has-key?"
(assert-true (has-key? {:a 1} "a"))
(assert-false (has-key? {:a 1} "b")))
(deftest "merge"
(assert-equal {:a 1 :b 2 :c 3}
(merge {:a 1 :b 2} {:c 3}))
(assert-equal {:a 99 :b 2}
(merge {:a 1 :b 2} {:a 99}))))
;; --------------------------------------------------------------------------
;; 3g. Predicates
;; --------------------------------------------------------------------------
(defsuite "predicates"
(deftest "nil?"
(assert-true (nil? nil))
(assert-false (nil? 0))
(assert-false (nil? false))
(assert-false (nil? "")))
(deftest "number?"
(assert-true (number? 42))
(assert-true (number? 3.14))
(assert-false (number? "42")))
(deftest "string?"
(assert-true (string? "hello"))
(assert-false (string? 42)))
(deftest "list?"
(assert-true (list? (list 1 2)))
(assert-false (list? "not a list")))
(deftest "dict?"
(assert-true (dict? {:a 1}))
(assert-false (dict? (list 1))))
(deftest "boolean?"
(assert-true (boolean? true))
(assert-true (boolean? false))
(assert-false (boolean? nil))
(assert-false (boolean? 0)))
(deftest "not"
(assert-true (not false))
(assert-true (not nil))
(assert-false (not true))
(assert-false (not 1))
(assert-false (not "x"))))
;; --------------------------------------------------------------------------
;; 3h. Special forms
;; --------------------------------------------------------------------------
(defsuite "special-forms"
(deftest "if"
(assert-equal "yes" (if true "yes" "no"))
(assert-equal "no" (if false "yes" "no"))
(assert-equal "no" (if nil "yes" "no"))
(assert-nil (if false "yes")))
(deftest "when"
(assert-equal "yes" (when true "yes"))
(assert-nil (when false "yes")))
(deftest "cond"
(assert-equal "a" (cond true "a" :else "b"))
(assert-equal "b" (cond false "a" :else "b"))
(assert-equal "c" (cond
false "a"
false "b"
:else "c")))
(deftest "and"
(assert-true (and true true))
(assert-false (and true false))
(assert-false (and false true))
(assert-equal 3 (and 1 2 3)))
(deftest "or"
(assert-equal 1 (or 1 2))
(assert-equal 2 (or false 2))
(assert-equal "fallback" (or nil false "fallback"))
(assert-false (or false false)))
(deftest "let"
(assert-equal 3 (let ((x 1) (y 2)) (+ x y)))
(assert-equal "hello world"
(let ((a "hello") (b " world")) (str a b))))
(deftest "let clojure-style"
(assert-equal 3 (let (x 1 y 2) (+ x y))))
(deftest "do / begin"
(assert-equal 3 (do 1 2 3))
(assert-equal "last" (begin "first" "middle" "last")))
(deftest "define"
(define x 42)
(assert-equal 42 x))
(deftest "set!"
(define x 1)
(set! x 2)
(assert-equal 2 x)))
;; --------------------------------------------------------------------------
;; 3i. Lambda and closures
;; --------------------------------------------------------------------------
(defsuite "lambdas"
(deftest "basic lambda"
(let ((add (fn (a b) (+ a b))))
(assert-equal 3 (add 1 2))))
(deftest "closure captures env"
(let ((x 10))
(let ((add-x (fn (y) (+ x y))))
(assert-equal 15 (add-x 5)))))
(deftest "lambda as argument"
(assert-equal (list 2 4 6)
(map (fn (x) (* x 2)) (list 1 2 3))))
(deftest "recursive lambda via define"
(define factorial
(fn (n) (if (<= n 1) 1 (* n (factorial (- n 1))))))
(assert-equal 120 (factorial 5)))
(deftest "higher-order returns lambda"
(let ((make-adder (fn (n) (fn (x) (+ n x)))))
(let ((add5 (make-adder 5)))
(assert-equal 8 (add5 3))))))
;; --------------------------------------------------------------------------
;; 3j. Higher-order forms
;; --------------------------------------------------------------------------
(defsuite "higher-order"
(deftest "map"
(assert-equal (list 2 4 6)
(map (fn (x) (* x 2)) (list 1 2 3)))
(assert-equal (list) (map (fn (x) x) (list))))
(deftest "filter"
(assert-equal (list 2 4)
(filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4)))
(assert-equal (list)
(filter (fn (x) false) (list 1 2 3))))
(deftest "reduce"
(assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)))
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))))
(deftest "some"
(assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5)))
(assert-false (some (fn (x) (> x 10)) (list 1 2 3))))
(deftest "every?"
(assert-true (every? (fn (x) (> x 0)) (list 1 2 3)))
(assert-false (every? (fn (x) (> x 2)) (list 1 2 3))))
(deftest "map-indexed"
(assert-equal (list "0:a" "1:b" "2:c")
(map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c")))))
;; --------------------------------------------------------------------------
;; 3k. Components
;; --------------------------------------------------------------------------
(defsuite "components"
(deftest "defcomp creates component"
(defcomp ~test-comp (&key title)
(div title))
;; Component is bound and not nil
(assert-true (not (nil? ~test-comp))))
(deftest "component renders with keyword args"
(defcomp ~greeting (&key name)
(span (str "Hello, " name "!")))
(assert-true (not (nil? ~greeting))))
(deftest "component with children"
(defcomp ~box (&key &rest children)
(div :class "box" children))
(assert-true (not (nil? ~box))))
(deftest "component with default via or"
(defcomp ~label (&key text)
(span (or text "default")))
(assert-true (not (nil? ~label)))))
;; --------------------------------------------------------------------------
;; 3l. Macros
;; --------------------------------------------------------------------------
(defsuite "macros"
(deftest "defmacro creates macro"
(defmacro unless (cond &rest body)
`(if (not ,cond) (do ,@body)))
(assert-equal "yes" (unless false "yes"))
(assert-nil (unless true "no")))
(deftest "quasiquote and unquote"
(let ((x 42))
(assert-equal (list 1 42 3) `(1 ,x 3))))
(deftest "splice-unquote"
(let ((xs (list 2 3 4)))
(assert-equal (list 1 2 3 4 5) `(1 ,@xs 5)))))
;; --------------------------------------------------------------------------
;; 3m. Threading macro
;; --------------------------------------------------------------------------
(defsuite "threading"
(deftest "thread-first"
(assert-equal 8 (-> 5 (+ 1) (+ 2)))
(assert-equal "HELLO" (-> "hello" upcase))
(assert-equal "HELLO WORLD"
(-> "hello"
(str " world")
upcase))))
;; --------------------------------------------------------------------------
;; 3n. Truthiness
;; --------------------------------------------------------------------------
(defsuite "truthiness"
(deftest "truthy values"
(assert-true (if 1 true false))
(assert-true (if "x" true false))
(assert-true (if (list 1) true false))
(assert-true (if true true false)))
(deftest "falsy values"
(assert-false (if false true false))
(assert-false (if nil true false)))
;; NOTE: empty list, zero, and empty string truthiness is
;; platform-dependent. Python treats all three as falsy.
;; JavaScript treats [] as truthy but 0 and "" as falsy.
;; These tests are omitted — each bootstrapper should emit
;; platform-specific truthiness tests instead.
)
;; --------------------------------------------------------------------------
;; 3o. Edge cases and regression tests
;; --------------------------------------------------------------------------
(defsuite "edge-cases"
(deftest "nested let scoping"
(let ((x 1))
(let ((x 2))
(assert-equal 2 x))
;; outer x should be unchanged by inner let
;; (this tests that let creates a new scope)
))
(deftest "recursive map"
(assert-equal (list (list 2 4) (list 6 8))
(map (fn (sub) (map (fn (x) (* x 2)) sub))
(list (list 1 2) (list 3 4)))))
(deftest "keyword as value"
(assert-equal "class" :class)
(assert-equal "id" :id))
(deftest "dict with evaluated values"
(let ((x 42))
(assert-equal 42 (get {:val x} "val"))))
(deftest "nil propagation"
(assert-nil (get {:a 1} "missing"))
(assert-equal "default" (or (get {:a 1} "missing") "default")))
(deftest "empty operations"
(assert-equal (list) (map (fn (x) x) (list)))
(assert-equal (list) (filter (fn (x) true) (list)))
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))
(assert-equal 0 (len (list)))
(assert-equal "" (str))))

0
shared/sx/ref/test-cek.sx → spec/tests/test-cek.sx
View File

0
shared/sx/ref/test-continuations.sx → spec/tests/test-continuations.sx
View File

0
shared/sx/ref/test-eval.sx → spec/tests/test-eval.sx
View File

0
shared/sx/ref/test-framework.sx → spec/tests/test-framework.sx
View File

0
shared/sx/ref/test-parser.sx → spec/tests/test-parser.sx
View File

0
shared/sx/ref/test-render.sx → spec/tests/test-render.sx
View File

0
shared/sx/ref/test-types.sx → spec/tests/test-types.sx
View File

0
shared/sx/ref/test.sx → spec/tests/test.sx
View File