diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 17350d7..48db83e 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -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); } diff --git a/shared/sx/ref/callcc.sx b/shared/sx/ref/callcc.sx deleted file mode 100644 index 6fe6716..0000000 --- a/shared/sx/ref/callcc.sx +++ /dev/null @@ -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). -;; -;; -------------------------------------------------------------------------- diff --git a/shared/sx/ref/cek.sx b/shared/sx/ref/cek.sx deleted file mode 100644 index b93437f..0000000 --- a/shared/sx/ref/cek.sx +++ /dev/null @@ -1,1178 +0,0 @@ -;; ========================================================================== -;; cek.sx — Explicit CEK machine evaluator -;; -;; Replaces the implicit CEK (tree-walk + trampoline) with explicit -;; C/E/K data structures. Each evaluation step is a pure function from -;; state to state. Enables stepping, serialization, migration. -;; -;; The CEK uses the frame types defined in frames.sx. -;; eval-expr remains as the public API — it creates a CEK state and runs. -;; -;; Requires: frames.sx loaded first. -;; ========================================================================== - - -;; -------------------------------------------------------------------------- -;; 1. Run loop — drive the CEK machine to completion -;; -------------------------------------------------------------------------- - -(define cek-run - (fn (state) - ;; Drive the CEK machine until terminal state. - ;; Returns the final value. - (if (cek-terminal? state) - (cek-value state) - (cek-run (cek-step state))))) - - -;; -------------------------------------------------------------------------- -;; 2. Step function — single CEK step -;; -------------------------------------------------------------------------- - -(define cek-step - (fn (state) - (if (= (cek-phase state) "eval") - (step-eval state) - (step-continue state)))) - - -;; -------------------------------------------------------------------------- -;; 3. step-eval — Control is an expression, dispatch on type -;; -------------------------------------------------------------------------- - -(define step-eval - (fn (state) - (let ((expr (cek-control state)) - (env (cek-env state)) - (kont (cek-kont state))) - (case (type-of expr) - - ;; --- Literals: immediate value --- - "number" (make-cek-value expr env kont) - "string" (make-cek-value expr env kont) - "boolean" (make-cek-value expr env kont) - "nil" (make-cek-value nil env kont) - - ;; --- Symbol lookup --- - "symbol" - (let ((name (symbol-name expr))) - (let ((val (cond - (env-has? env name) (env-get env name) - (primitive? name) (get-primitive name) - (= name "true") true - (= name "false") false - (= name "nil") nil - :else (error (str "Undefined symbol: " name))))) - (make-cek-value val env kont))) - - ;; --- Keyword → string --- - "keyword" (make-cek-value (keyword-name expr) env kont) - - ;; --- Dict literal: evaluate values --- - "dict" - (let ((ks (keys expr))) - (if (empty? ks) - (make-cek-value (dict) env kont) - ;; Build entry pairs from dict, evaluate first value - (let ((first-key (first ks)) - (remaining-entries (list))) - (for-each (fn (k) (append! remaining-entries (list k (get expr k)))) - (rest ks)) - (make-cek-state - (get expr first-key) - env - (kont-push - (make-dict-frame - remaining-entries - (list (list first-key)) ;; results: list of (key) waiting for val - env) - kont))))) - - ;; --- List = call or special form --- - "list" - (if (empty? expr) - (make-cek-value (list) env kont) - (step-eval-list expr env kont)) - - ;; --- Anything else passes through --- - :else (make-cek-value expr env kont))))) - - -;; -------------------------------------------------------------------------- -;; 4. step-eval-list — Dispatch on list head -;; -------------------------------------------------------------------------- - -(define step-eval-list - (fn (expr env kont) - (let ((head (first expr)) - (args (rest expr))) - - ;; If head isn't symbol/lambda/list → treat as data list - (if (not (or (= (type-of head) "symbol") - (= (type-of head) "lambda") - (= (type-of head) "list"))) - ;; Evaluate as data list — evaluate each element - (if (empty? expr) - (make-cek-value (list) env kont) - (make-cek-state - (first expr) env - (kont-push (make-map-frame nil (rest expr) (list) env) kont))) - - ;; Head is symbol — check special forms - (if (= (type-of head) "symbol") - (let ((name (symbol-name head))) - (cond - ;; --- Special forms → push appropriate frame --- - (= name "if") (step-sf-if args env kont) - (= name "when") (step-sf-when args env kont) - (= name "cond") (step-sf-cond args env kont) - (= name "case") (step-sf-case args env kont) - (= name "and") (step-sf-and args env kont) - (= name "or") (step-sf-or args env kont) - (= name "let") (step-sf-let args env kont) - (= name "let*") (step-sf-let args env kont) - (= name "lambda") (step-sf-lambda args env kont) - (= name "fn") (step-sf-lambda args env kont) - (= name "define") (step-sf-define args env kont) - (= name "defcomp") (make-cek-value (sf-defcomp args env) env kont) - (= name "defisland") (make-cek-value (sf-defisland args env) env kont) - (= name "defmacro") (make-cek-value (sf-defmacro args env) env kont) - (= name "defstyle") (make-cek-value (sf-defstyle args env) env kont) - (= name "defhandler") (make-cek-value (sf-defhandler args env) env kont) - (= name "defpage") (make-cek-value (sf-defpage args env) env kont) - (= name "defquery") (make-cek-value (sf-defquery args env) env kont) - (= name "defaction") (make-cek-value (sf-defaction args env) env kont) - (= name "deftype") (make-cek-value (sf-deftype args env) env kont) - (= name "defeffect") (make-cek-value (sf-defeffect args env) env kont) - (= name "begin") (step-sf-begin args env kont) - (= name "do") (step-sf-begin args env kont) - (= name "quote") (make-cek-value (if (empty? args) nil (first args)) env kont) - (= name "quasiquote") (make-cek-value (qq-expand (first args) env) env kont) - (= name "->") (step-sf-thread-first args env kont) - (= name "set!") (step-sf-set! args env kont) - (= name "letrec") (make-cek-value (sf-letrec args env) env kont) - - ;; Continuations — native in CEK - (= name "reset") (step-sf-reset args env kont) - (= name "shift") (step-sf-shift args env kont) - - ;; Reactive deref-as-shift - (= name "deref") (step-sf-deref args env kont) - - ;; Scoped effects - (= name "scope") (step-sf-scope args env kont) - (= name "provide") (step-sf-provide args env kont) - - ;; Dynamic wind - (= name "dynamic-wind") (make-cek-value (sf-dynamic-wind args env) env kont) - - ;; Higher-order forms - (= name "map") (step-ho-map args env kont) - (= name "map-indexed") (step-ho-map-indexed args env kont) - (= name "filter") (step-ho-filter args env kont) - (= name "reduce") (step-ho-reduce args env kont) - (= name "some") (step-ho-some args env kont) - (= name "every?") (step-ho-every args env kont) - (= name "for-each") (step-ho-for-each args env kont) - - ;; Macro expansion - (and (env-has? env name) (macro? (env-get env name))) - (let ((mac (env-get env name))) - (make-cek-state (expand-macro mac args env) env kont)) - - ;; Render expression - (and (render-active?) (is-render-expr? expr)) - (make-cek-value (render-expr expr env) env kont) - - ;; Fall through to function call - :else (step-eval-call head args env kont))) - - ;; Head is lambda or list — function call - (step-eval-call head args env kont)))))) - - -;; -------------------------------------------------------------------------- -;; 5. Special form step handlers -;; -------------------------------------------------------------------------- - -;; if: evaluate condition, push IfFrame -(define step-sf-if - (fn (args env kont) - (make-cek-state - (first args) env - (kont-push - (make-if-frame (nth args 1) - (if (> (len args) 2) (nth args 2) nil) - env) - kont)))) - -;; when: evaluate condition, push WhenFrame -(define step-sf-when - (fn (args env kont) - (make-cek-state - (first args) env - (kont-push (make-when-frame (rest args) env) kont)))) - -;; begin/do: evaluate first expr, push BeginFrame for rest -(define step-sf-begin - (fn (args env kont) - (if (empty? args) - (make-cek-value nil env kont) - (if (= (len args) 1) - (make-cek-state (first args) env kont) - (make-cek-state - (first args) env - (kont-push (make-begin-frame (rest args) env) kont)))))) - -;; let: start evaluating bindings -(define step-sf-let - (fn (args env kont) - ;; Detect named let - (if (= (type-of (first args)) "symbol") - ;; Named let — delegate to existing handler (complex desugaring) - (make-cek-value (sf-named-let args env) env kont) - (let ((bindings (first args)) - (body (rest args)) - (local (env-extend env))) - ;; Parse first binding - (if (empty? bindings) - ;; No bindings — evaluate body - (step-sf-begin body local kont) - ;; Start evaluating first binding value - (let ((first-binding (if (and (= (type-of (first bindings)) "list") - (= (len (first bindings)) 2)) - ;; Scheme-style: ((name val) ...) - (first bindings) - ;; Clojure-style: (name val ...) → synthesize pair - (list (first bindings) (nth bindings 1)))) - (rest-bindings (if (and (= (type-of (first bindings)) "list") - (= (len (first bindings)) 2)) - (rest bindings) - ;; Clojure-style: skip 2 elements - (let ((pairs (list))) - (reduce - (fn (acc i) - (append! pairs (list (nth bindings (* i 2)) - (nth bindings (inc (* i 2)))))) - nil - (range 1 (/ (len bindings) 2))) - pairs)))) - (let ((vname (if (= (type-of (first first-binding)) "symbol") - (symbol-name (first first-binding)) - (first first-binding)))) - (make-cek-state - (nth first-binding 1) local - (kont-push - (make-let-frame vname rest-bindings body local) - kont))))))))) - -;; define: evaluate value expression -(define step-sf-define - (fn (args env kont) - (let ((name-sym (first args)) - (has-effects (and (>= (len args) 4) - (= (type-of (nth args 1)) "keyword") - (= (keyword-name (nth args 1)) "effects"))) - (val-idx (if (and (>= (len args) 4) - (= (type-of (nth args 1)) "keyword") - (= (keyword-name (nth args 1)) "effects")) - 3 1)) - (effect-list (if (and (>= (len args) 4) - (= (type-of (nth args 1)) "keyword") - (= (keyword-name (nth args 1)) "effects")) - (nth args 2) nil))) - (make-cek-state - (nth args val-idx) env - (kont-push - (make-define-frame (symbol-name name-sym) env has-effects effect-list) - kont))))) - -;; set!: evaluate value -(define step-sf-set! - (fn (args env kont) - (make-cek-state - (nth args 1) env - (kont-push (make-set-frame (symbol-name (first args)) env) kont)))) - -;; and: evaluate first, push AndFrame -(define step-sf-and - (fn (args env kont) - (if (empty? args) - (make-cek-value true env kont) - (make-cek-state - (first args) env - (kont-push (make-and-frame (rest args) env) kont))))) - -;; or: evaluate first, push OrFrame -(define step-sf-or - (fn (args env kont) - (if (empty? args) - (make-cek-value false env kont) - (make-cek-state - (first args) env - (kont-push (make-or-frame (rest args) env) kont))))) - -;; cond: evaluate first test, push CondFrame -(define step-sf-cond - (fn (args env kont) - (let ((scheme? (cond-scheme? args))) - (if scheme? - ;; Scheme-style: ((test body) ...) - (if (empty? args) - (make-cek-value nil env kont) - (let ((clause (first args)) - (test (first clause))) - ;; Check for :else / else - (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"))) - (make-cek-state (nth clause 1) env kont) - (make-cek-state - test env - (kont-push (make-cond-frame args env true) kont))))) - ;; Clojure-style: test body test body ... - (if (< (len args) 2) - (make-cek-value nil env kont) - (let ((test (first args))) - (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")))) - (make-cek-state (nth args 1) env kont) - (make-cek-state - test env - (kont-push (make-cond-frame args env false) kont))))))))) - -;; case: evaluate match value -(define step-sf-case - (fn (args env kont) - (make-cek-state - (first args) env - (kont-push (make-case-frame nil (rest args) env) kont)))) - -;; thread-first: evaluate initial value -(define step-sf-thread-first - (fn (args env kont) - (make-cek-state - (first args) env - (kont-push (make-thread-frame (rest args) env) kont)))) - -;; lambda/fn: immediate — create lambda value -(define step-sf-lambda - (fn (args env kont) - (make-cek-value (sf-lambda args env) env kont))) - -;; scope: evaluate name, then push ScopeFrame -(define step-sf-scope - (fn (args env kont) - ;; Delegate to existing sf-scope for now — scope involves mutation - (make-cek-value (sf-scope args env) env kont))) - -;; provide: delegate to existing handler -(define step-sf-provide - (fn (args env kont) - (make-cek-value (sf-provide args env) env kont))) - -;; reset: push ResetFrame, evaluate body -(define step-sf-reset - (fn (args env kont) - (make-cek-state - (first args) env - (kont-push (make-reset-frame env) kont)))) - -;; shift: capture frames to nearest reset -(define step-sf-shift - (fn (args env kont) - (let ((k-name (symbol-name (first args))) - (body (nth args 1)) - (captured-result (kont-capture-to-reset kont)) - (captured (first captured-result)) - (rest-kont (nth captured-result 1))) - ;; Store captured frames as a dict on the continuation value. - ;; When the continuation is invoked, continue-with-call detects - ;; the cek-frames key and restores them. - (let ((k (make-cek-continuation captured rest-kont))) - ;; Evaluate shift body with k bound, continuation goes to rest-kont - (let ((shift-env (env-extend env))) - (env-set! shift-env k-name k) - (make-cek-state body shift-env rest-kont)))))) - - -;; deref: evaluate argument, push DerefFrame -(define step-sf-deref - (fn (args env kont) - (make-cek-state - (first args) env - (kont-push (make-deref-frame env) kont)))) - -;; cek-call — call a function via CEK (replaces invoke) -(define cek-call - (fn (f args) - (let ((a (if (nil? args) (list) args))) - (cond - (nil? f) nil - (lambda? f) (cek-run (continue-with-call f a (dict) a (list))) - (callable? f) (apply f a) - :else nil)))) - -;; reactive-shift-deref: the heart of deref-as-shift -;; When deref encounters a signal inside a reactive-reset boundary, -;; capture the continuation up to the reactive-reset as the subscriber. -(define reactive-shift-deref - (fn (sig env kont) - (let ((scan-result (kont-capture-to-reactive-reset kont)) - (captured-frames (first scan-result)) - (reset-frame (nth scan-result 1)) - (remaining-kont (nth scan-result 2)) - (update-fn (get reset-frame "update-fn"))) - ;; Sub-scope for nested subscriber cleanup on re-invocation - (let ((sub-disposers (list))) - (let ((subscriber - (fn () - ;; Dispose previous nested subscribers - (for-each (fn (d) (cek-call d nil)) sub-disposers) - (set! sub-disposers (list)) - ;; Re-invoke: push fresh ReactiveResetFrame (first-render=false) - (let ((new-reset (make-reactive-reset-frame env update-fn false)) - (new-kont (concat captured-frames - (list new-reset) - remaining-kont))) - (with-island-scope - (fn (d) (append! sub-disposers d)) - (fn () - (cek-run - (make-cek-value (signal-value sig) env new-kont)))))))) - ;; Register subscriber - (signal-add-sub! sig subscriber) - ;; Register cleanup with island scope - (register-in-scope - (fn () - (signal-remove-sub! sig subscriber) - (for-each (fn (d) (cek-call d nil)) sub-disposers))) - ;; Initial render: value flows through captured frames + reset (first-render=true) - ;; so the full expression completes normally - (let ((initial-kont (concat captured-frames - (list reset-frame) - remaining-kont))) - (make-cek-value (signal-value sig) env initial-kont))))))) - - -;; -------------------------------------------------------------------------- -;; 6. Function call step handler -;; -------------------------------------------------------------------------- - -(define step-eval-call - (fn (head args env kont) - ;; First evaluate the head, then evaluate args left-to-right - (make-cek-state - head env - (kont-push - (make-arg-frame nil (list) args env args) - kont)))) - - -;; -------------------------------------------------------------------------- -;; 7. Higher-order form step handlers -;; -------------------------------------------------------------------------- - -;; CEK-native higher-order forms — each callback invocation goes through -;; continue-with-call so deref-as-shift works inside callbacks. -;; Function and collection args are evaluated via tree-walk (simple exprs), -;; then the loop is driven by CEK frames. - -(define step-ho-map - (fn (args env kont) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (if (empty? coll) - (make-cek-value (list) env kont) - (continue-with-call f (list (first coll)) env (list) - (kont-push (make-map-frame f (rest coll) (list) env) kont)))))) - -(define step-ho-map-indexed - (fn (args env kont) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (if (empty? coll) - (make-cek-value (list) env kont) - (continue-with-call f (list 0 (first coll)) env (list) - (kont-push (make-map-indexed-frame f (rest coll) (list) env) kont)))))) - -(define step-ho-filter - (fn (args env kont) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (if (empty? coll) - (make-cek-value (list) env kont) - (continue-with-call f (list (first coll)) env (list) - (kont-push (make-filter-frame f (rest coll) (list) (first coll) env) kont)))))) - -(define step-ho-reduce - (fn (args env kont) - (let ((f (trampoline (eval-expr (first args) env))) - (init (trampoline (eval-expr (nth args 1) env))) - (coll (trampoline (eval-expr (nth args 2) env)))) - (if (empty? coll) - (make-cek-value init env kont) - (continue-with-call f (list init (first coll)) env (list) - (kont-push (make-reduce-frame f (rest coll) env) kont)))))) - -(define step-ho-some - (fn (args env kont) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (if (empty? coll) - (make-cek-value false env kont) - (continue-with-call f (list (first coll)) env (list) - (kont-push (make-some-frame f (rest coll) env) kont)))))) - -(define step-ho-every - (fn (args env kont) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (if (empty? coll) - (make-cek-value true env kont) - (continue-with-call f (list (first coll)) env (list) - (kont-push (make-every-frame f (rest coll) env) kont)))))) - -(define step-ho-for-each - (fn (args env kont) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (if (empty? coll) - (make-cek-value nil env kont) - (continue-with-call f (list (first coll)) env (list) - (kont-push (make-for-each-frame f (rest coll) env) kont)))))) - - -;; -------------------------------------------------------------------------- -;; 8. step-continue — Value produced, dispatch on top frame -;; -------------------------------------------------------------------------- - -(define step-continue - (fn (state) - (let ((value (cek-value state)) - (env (cek-env state)) - (kont (cek-kont state))) - (if (kont-empty? kont) - state ;; Terminal — return as-is - (let ((frame (kont-top kont)) - (rest-k (kont-pop kont)) - (ft (frame-type frame))) - (cond - - ;; --- IfFrame: condition evaluated --- - (= ft "if") - (if (and value (not (nil? value))) - (make-cek-state (get frame "then") (get frame "env") rest-k) - (if (nil? (get frame "else")) - (make-cek-value nil env rest-k) - (make-cek-state (get frame "else") (get frame "env") rest-k))) - - ;; --- WhenFrame: condition evaluated --- - (= ft "when") - (if (and value (not (nil? value))) - (let ((body (get frame "body")) - (fenv (get frame "env"))) - (if (empty? body) - (make-cek-value nil fenv rest-k) - (if (= (len body) 1) - (make-cek-state (first body) fenv rest-k) - (make-cek-state - (first body) fenv - (kont-push (make-begin-frame (rest body) fenv) rest-k))))) - (make-cek-value nil env rest-k)) - - ;; --- BeginFrame: expression evaluated, continue with next --- - (= ft "begin") - (let ((remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if (empty? remaining) - (make-cek-value value fenv rest-k) - (if (= (len remaining) 1) - (make-cek-state (first remaining) fenv rest-k) - (make-cek-state - (first remaining) fenv - (kont-push (make-begin-frame (rest remaining) fenv) rest-k))))) - - ;; --- LetFrame: binding value evaluated --- - (= ft "let") - (let ((name (get frame "name")) - (remaining (get frame "remaining")) - (body (get frame "body")) - (local (get frame "env"))) - ;; Bind the value - (env-set! local name value) - ;; More bindings? - (if (empty? remaining) - ;; All bindings done — evaluate body - (step-sf-begin body local rest-k) - ;; Next binding - (let ((next-binding (first remaining)) - (vname (if (= (type-of (first next-binding)) "symbol") - (symbol-name (first next-binding)) - (first next-binding)))) - (make-cek-state - (nth next-binding 1) local - (kont-push - (make-let-frame vname (rest remaining) body local) - rest-k))))) - - ;; --- DefineFrame: value evaluated --- - (= ft "define") - (let ((name (get frame "name")) - (fenv (get frame "env")) - (has-effects (get frame "has-effects")) - (effect-list (get frame "effect-list"))) - (when (and (lambda? value) (nil? (lambda-name value))) - (set-lambda-name! value name)) - (env-set! fenv name value) - ;; Effect annotation - (when has-effects - (let ((effect-names (if (= (type-of effect-list) "list") - (map (fn (e) (if (= (type-of e) "symbol") - (symbol-name e) (str e))) - effect-list) - (list (str effect-list)))) - (effect-anns (if (env-has? fenv "*effect-annotations*") - (env-get fenv "*effect-annotations*") - (dict)))) - (dict-set! effect-anns name effect-names) - (env-set! fenv "*effect-annotations*" effect-anns))) - (make-cek-value value fenv rest-k)) - - ;; --- SetFrame: value evaluated --- - (= ft "set") - (let ((name (get frame "name")) - (fenv (get frame "env"))) - (env-set! fenv name value) - (make-cek-value value env rest-k)) - - ;; --- AndFrame: value evaluated --- - (= ft "and") - (if (not value) - (make-cek-value value env rest-k) - (let ((remaining (get frame "remaining"))) - (if (empty? remaining) - (make-cek-value value env rest-k) - (make-cek-state - (first remaining) (get frame "env") - (if (= (len remaining) 1) - rest-k - (kont-push (make-and-frame (rest remaining) (get frame "env")) rest-k)))))) - - ;; --- OrFrame: value evaluated --- - (= ft "or") - (if value - (make-cek-value value env rest-k) - (let ((remaining (get frame "remaining"))) - (if (empty? remaining) - (make-cek-value false env rest-k) - (make-cek-state - (first remaining) (get frame "env") - (if (= (len remaining) 1) - rest-k - (kont-push (make-or-frame (rest remaining) (get frame "env")) rest-k)))))) - - ;; --- CondFrame: test evaluated --- - (= ft "cond") - (let ((remaining (get frame "remaining")) - (fenv (get frame "env")) - (scheme? (get frame "scheme"))) - (if scheme? - ;; Scheme-style: test truthy → evaluate body - (if value - (make-cek-state (nth (first remaining) 1) fenv rest-k) - ;; Next clause - (let ((next-clauses (rest remaining))) - (if (empty? next-clauses) - (make-cek-value nil fenv rest-k) - (let ((next-clause (first next-clauses)) - (next-test (first next-clause))) - (if (or (and (= (type-of next-test) "symbol") - (or (= (symbol-name next-test) "else") - (= (symbol-name next-test) ":else"))) - (and (= (type-of next-test) "keyword") - (= (keyword-name next-test) "else"))) - (make-cek-state (nth next-clause 1) fenv rest-k) - (make-cek-state - next-test fenv - (kont-push (make-cond-frame next-clauses fenv true) rest-k))))))) - ;; Clojure-style - (if value - (make-cek-state (nth remaining 1) fenv rest-k) - (let ((next (slice remaining 2))) - (if (< (len next) 2) - (make-cek-value nil fenv rest-k) - (let ((next-test (first next))) - (if (or (and (= (type-of next-test) "keyword") (= (keyword-name next-test) "else")) - (and (= (type-of next-test) "symbol") - (or (= (symbol-name next-test) "else") - (= (symbol-name next-test) ":else")))) - (make-cek-state (nth next 1) fenv rest-k) - (make-cek-state - next-test fenv - (kont-push (make-cond-frame next fenv false) rest-k))))))))) - - ;; --- CaseFrame --- - (= ft "case") - (let ((match-val (get frame "match-val")) - (remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if (nil? match-val) - ;; First step: match-val just evaluated - (sf-case-step-loop value remaining fenv rest-k) - ;; Subsequent: test clause evaluated - (sf-case-step-loop match-val remaining fenv rest-k))) - - ;; --- ThreadFirstFrame --- - (= ft "thread") - (let ((remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if (empty? remaining) - (make-cek-value value fenv rest-k) - ;; Apply next form to value - (let ((form (first remaining)) - (rest-forms (rest remaining))) - (let ((result (if (= (type-of form) "list") - (let ((f (trampoline (eval-expr (first form) fenv))) - (rargs (map (fn (a) (trampoline (eval-expr a fenv))) (rest form))) - (all-args (cons value rargs))) - (cond - (and (callable? f) (not (lambda? f))) (apply f all-args) - (lambda? f) (trampoline (call-lambda f all-args fenv)) - :else (error (str "-> form not callable: " (inspect f))))) - (let ((f (trampoline (eval-expr form fenv)))) - (cond - (and (callable? f) (not (lambda? f))) (f value) - (lambda? f) (trampoline (call-lambda f (list value) fenv)) - :else (error (str "-> form not callable: " (inspect f)))))))) - (if (empty? rest-forms) - (make-cek-value result fenv rest-k) - (make-cek-value result fenv - (kont-push (make-thread-frame rest-forms fenv) rest-k))))))) - - ;; --- ArgFrame: head or arg evaluated --- - (= ft "arg") - (let ((f (get frame "f")) - (evaled (get frame "evaled")) - (remaining (get frame "remaining")) - (fenv (get frame "env")) - (raw-args (get frame "raw-args"))) - (if (nil? f) - ;; Head just evaluated — value is the function - (if (empty? remaining) - ;; No args — call immediately - (continue-with-call value (list) fenv raw-args rest-k) - ;; Start evaluating args - (make-cek-state - (first remaining) fenv - (kont-push - (make-arg-frame value (list) (rest remaining) fenv raw-args) - rest-k))) - ;; An arg was evaluated — accumulate - (let ((new-evaled (append evaled (list value)))) - (if (empty? remaining) - ;; All args evaluated — call - (continue-with-call f new-evaled fenv raw-args rest-k) - ;; Next arg - (make-cek-state - (first remaining) fenv - (kont-push - (make-arg-frame f new-evaled (rest remaining) fenv raw-args) - rest-k)))))) - - ;; --- DictFrame: value evaluated --- - (= ft "dict") - (let ((remaining (get frame "remaining")) - (results (get frame "results")) - (fenv (get frame "env"))) - ;; Last result entry is (key) — append value to make (key val) - (let ((last-result (last results)) - (completed (append (slice results 0 (dec (len results))) - (list (list (first last-result) value))))) - (if (empty? remaining) - ;; All done — build dict - (let ((d (dict))) - (for-each - (fn (pair) (dict-set! d (first pair) (nth pair 1))) - completed) - (make-cek-value d fenv rest-k)) - ;; Next entry - (let ((next-entry (first remaining))) - (make-cek-state - (nth next-entry 1) fenv - (kont-push - (make-dict-frame - (rest remaining) - (append completed (list (list (first next-entry)))) - fenv) - rest-k)))))) - - ;; --- ResetFrame: body evaluated normally (no shift) --- - (= ft "reset") - (make-cek-value value env rest-k) - - ;; --- DerefFrame: deref argument evaluated --- - (= ft "deref") - (let ((val value) - (fenv (get frame "env"))) - (if (not (signal? val)) - ;; Not a signal: pass through - (make-cek-value val fenv rest-k) - ;; Signal: check for ReactiveResetFrame - (if (has-reactive-reset-frame? rest-k) - ;; Perform reactive shift - (reactive-shift-deref val fenv rest-k) - ;; No reactive-reset: normal deref (scope-based tracking) - (do - (let ((ctx (context "sx-reactive" nil))) - (when ctx - (let ((dep-list (get ctx "deps")) - (notify-fn (get ctx "notify"))) - (when (not (contains? dep-list val)) - (append! dep-list val) - (signal-add-sub! val notify-fn))))) - (make-cek-value (signal-value val) fenv rest-k))))) - - ;; --- ReactiveResetFrame: expression completed --- - (= ft "reactive-reset") - (let ((update-fn (get frame "update-fn")) - (first? (get frame "first-render"))) - ;; On re-render (not first), call update-fn with new value - (when (and update-fn (not first?)) - (cek-call update-fn (list value))) - (make-cek-value value env rest-k)) - - ;; --- ScopeFrame: body result --- - (= ft "scope") - (let ((name (get frame "name")) - (remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if (empty? remaining) - (do (scope-pop! name) - (make-cek-value value fenv rest-k)) - (make-cek-state - (first remaining) fenv - (kont-push - (make-scope-frame name (rest remaining) fenv) - rest-k)))) - - ;; --- MapFrame: callback result for map/map-indexed --- - (= ft "map") - (let ((f (get frame "f")) - (remaining (get frame "remaining")) - (results (get frame "results")) - (indexed (get frame "indexed")) - (fenv (get frame "env"))) - (let ((new-results (append results (list value)))) - (if (empty? remaining) - (make-cek-value new-results fenv rest-k) - (let ((call-args (if indexed - (list (len new-results) (first remaining)) - (list (first remaining)))) - (next-frame (if indexed - (make-map-indexed-frame f (rest remaining) new-results fenv) - (make-map-frame f (rest remaining) new-results fenv)))) - (continue-with-call f call-args fenv (list) - (kont-push next-frame rest-k)))))) - - ;; --- FilterFrame: predicate result --- - (= ft "filter") - (let ((f (get frame "f")) - (remaining (get frame "remaining")) - (results (get frame "results")) - (current-item (get frame "current-item")) - (fenv (get frame "env"))) - (let ((new-results (if value - (append results (list current-item)) - results))) - (if (empty? remaining) - (make-cek-value new-results fenv rest-k) - (continue-with-call f (list (first remaining)) fenv (list) - (kont-push (make-filter-frame f (rest remaining) new-results (first remaining) fenv) rest-k))))) - - ;; --- ReduceFrame: accumulator step --- - (= ft "reduce") - (let ((f (get frame "f")) - (remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if (empty? remaining) - (make-cek-value value fenv rest-k) - (continue-with-call f (list value (first remaining)) fenv (list) - (kont-push (make-reduce-frame f (rest remaining) fenv) rest-k)))) - - ;; --- ForEachFrame: side effect, discard result --- - (= ft "for-each") - (let ((f (get frame "f")) - (remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if (empty? remaining) - (make-cek-value nil fenv rest-k) - (continue-with-call f (list (first remaining)) fenv (list) - (kont-push (make-for-each-frame f (rest remaining) fenv) rest-k)))) - - ;; --- SomeFrame: short-circuit on first truthy --- - (= ft "some") - (let ((f (get frame "f")) - (remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if value - (make-cek-value value fenv rest-k) - (if (empty? remaining) - (make-cek-value false fenv rest-k) - (continue-with-call f (list (first remaining)) fenv (list) - (kont-push (make-some-frame f (rest remaining) fenv) rest-k))))) - - ;; --- EveryFrame: short-circuit on first falsy --- - (= ft "every") - (let ((f (get frame "f")) - (remaining (get frame "remaining")) - (fenv (get frame "env"))) - (if (not value) - (make-cek-value false fenv rest-k) - (if (empty? remaining) - (make-cek-value true fenv rest-k) - (continue-with-call f (list (first remaining)) fenv (list) - (kont-push (make-every-frame f (rest remaining) fenv) rest-k))))) - - :else (error (str "Unknown frame type: " ft)))))))) - - -;; -------------------------------------------------------------------------- -;; 9. Helper: continue with function call -;; -------------------------------------------------------------------------- - -(define continue-with-call - (fn (f args env raw-args kont) - (cond - ;; Continuation — restore captured frames and inject value - (continuation? f) - (let ((arg (if (empty? args) nil (first args))) - (cont-data (continuation-data f))) - (let ((captured (get cont-data "captured")) - (rest-k (get cont-data "rest-kont"))) - (make-cek-value arg env (concat captured rest-k)))) - - ;; Native callable - (and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f))) - (make-cek-value (apply f args) env kont) - - ;; Lambda — bind params, evaluate body - (lambda? f) - (let ((params (lambda-params f)) - (local (env-merge (lambda-closure f) env))) - (if (> (len args) (len params)) - (error (str (or (lambda-name f) "lambda") - " expects " (len params) " args, got " (len args))) - (do - (for-each - (fn (pair) (env-set! local (first pair) (nth pair 1))) - (zip params args)) - (for-each - (fn (p) (env-set! local p nil)) - (slice params (len args))) - (make-cek-state (lambda-body f) local kont)))) - - ;; Component — parse kwargs, bind, evaluate body - (or (component? f) (island? f)) - (let ((parsed (parse-keyword-args raw-args env)) - (kwargs (first parsed)) - (children (nth parsed 1)) - (local (env-merge (component-closure f) env))) - (for-each - (fn (p) (env-set! local p (or (dict-get kwargs p) nil))) - (component-params f)) - (when (component-has-children? f) - (env-set! local "children" children)) - (make-cek-state (component-body f) local kont)) - - :else (error (str "Not callable: " (inspect f)))))) - - -;; -------------------------------------------------------------------------- -;; 10. Case step loop helper -;; -------------------------------------------------------------------------- - -(define sf-case-step-loop - (fn (match-val clauses env kont) - (if (< (len clauses) 2) - (make-cek-value nil env kont) - (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")))) - (make-cek-state body env kont) - ;; Evaluate test expression - (let ((test-val (trampoline (eval-expr test env)))) - (if (= match-val test-val) - (make-cek-state body env kont) - (sf-case-step-loop match-val (slice clauses 2) env kont)))))))) - - -;; -------------------------------------------------------------------------- -;; 11. Compatibility wrapper — eval-expr-cek -;; -------------------------------------------------------------------------- -;; -;; Drop-in replacement for eval-expr. Creates a CEK state and runs. -;; All downstream code (adapters, services) works unchanged. - -(define eval-expr-cek - (fn (expr env) - (cek-run (make-cek-state expr env (list))))) - -(define trampoline-cek - (fn (val) - ;; In CEK mode, thunks are not produced — values are immediate. - ;; But for compatibility, resolve any remaining thunks. - (if (thunk? val) - (eval-expr-cek (thunk-expr val) (thunk-env val)) - val))) - - - -;; -------------------------------------------------------------------------- -;; 13. Freeze scopes — named serializable state boundaries -;; -------------------------------------------------------------------------- -;; -;; A freeze scope collects signals registered within it. On freeze, -;; their current values are serialized to SX. On thaw, values are -;; restored. Multiple named scopes can coexist independently. -;; -;; Uses the scoped effects system: scope-push!/scope-pop!/context. -;; -;; Usage: -;; (freeze-scope "editor" -;; (let ((doc (signal "hello"))) -;; (freeze-signal "doc" doc) -;; ...)) -;; -;; (cek-freeze-scope "editor") → {:name "editor" :signals {:doc "hello"}} -;; (cek-thaw-scope "editor" frozen-data) → restores signal values - -;; Registry of freeze scopes: name → list of {name signal} entries -(define freeze-registry (dict)) - -;; Register a signal in the current freeze scope -(define freeze-signal :effects [mutation] - (fn (name sig) - (let ((scope-name (context "sx-freeze-scope" nil))) - (when scope-name - (let ((entries (or (get freeze-registry scope-name) (list)))) - (append! entries (dict "name" name "signal" sig)) - (dict-set! freeze-registry scope-name entries)))))) - -;; Freeze scope delimiter — collects signals registered within body -(define freeze-scope :effects [mutation] - (fn (name body-fn) - (scope-push! "sx-freeze-scope" name) - ;; Initialize empty entry list for this scope - (dict-set! freeze-registry name (list)) - (cek-call body-fn nil) - (scope-pop! "sx-freeze-scope") - nil)) - -;; Freeze a named scope → SX dict of signal values -(define cek-freeze-scope :effects [] - (fn (name) - (let ((entries (or (get freeze-registry name) (list))) - (signals-dict (dict))) - (for-each (fn (entry) - (dict-set! signals-dict - (get entry "name") - (signal-value (get entry "signal")))) - entries) - (dict "name" name "signals" signals-dict)))) - -;; Freeze all scopes -(define cek-freeze-all :effects [] - (fn () - (map (fn (name) (cek-freeze-scope name)) - (keys freeze-registry)))) - -;; Thaw a named scope — restore signal values from frozen data -(define cek-thaw-scope :effects [mutation] - (fn (name frozen) - (let ((entries (or (get freeze-registry name) (list))) - (values (get frozen "signals"))) - (when values - (for-each (fn (entry) - (let ((sig-name (get entry "name")) - (sig (get entry "signal")) - (val (get values sig-name))) - (when (not (nil? val)) - (reset! sig val)))) - entries))))) - -;; Thaw all scopes from a list of frozen scope dicts -(define cek-thaw-all :effects [mutation] - (fn (frozen-list) - (for-each (fn (frozen) - (cek-thaw-scope (get frozen "name") frozen)) - frozen-list))) - -;; Serialize a frozen scope to SX text -(define freeze-to-sx :effects [] - (fn (name) - (sx-serialize (cek-freeze-scope name)))) - -;; Restore from SX text -(define thaw-from-sx :effects [mutation] - (fn (sx-text) - (let ((parsed (sx-parse sx-text))) - (when (not (empty? parsed)) - (let ((frozen (first parsed))) - (cek-thaw-scope (get frozen "name") frozen)))))) - - - - -;; -------------------------------------------------------------------------- -;; 14. Content-addressed computation -;; -------------------------------------------------------------------------- -;; -;; Hash frozen SX to a content identifier. Store and retrieve by CID. -;; The content IS the address — same SX always produces the same CID. -;; -;; Uses an in-memory content store. Applications can persist to -;; localStorage or IPFS by providing their own store backend. - -(define content-store (dict)) - -(define content-hash :effects [] - (fn (sx-text) - ;; djb2 hash → hex string. Simple, deterministic, fast. - ;; Real deployment would use SHA-256 / multihash. - (let ((hash 5381)) - (for-each (fn (i) - (set! hash (mod (+ (* hash 33) (char-code-at sx-text i)) 4294967296))) - (range 0 (len sx-text))) - (to-hex hash)))) - -(define content-put :effects [mutation] - (fn (sx-text) - (let ((cid (content-hash sx-text))) - (dict-set! content-store cid sx-text) - cid))) - -(define content-get :effects [] - (fn (cid) - (get content-store cid))) - -;; Freeze a scope → store → return CID -(define freeze-to-cid :effects [mutation] - (fn (scope-name) - (let ((sx-text (freeze-to-sx scope-name))) - (content-put sx-text)))) - -;; Thaw from CID → look up → restore -(define thaw-from-cid :effects [mutation] - (fn (cid) - (let ((sx-text (content-get cid))) - (when sx-text - (thaw-from-sx sx-text) - true)))) diff --git a/shared/sx/ref/continuations.sx b/shared/sx/ref/continuations.sx deleted file mode 100644 index b5ae623..0000000 --- a/shared/sx/ref/continuations.sx +++ /dev/null @@ -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). -;; -;; -------------------------------------------------------------------------- diff --git a/shared/sx/ref/eval.sx b/shared/sx/ref/eval.sx deleted file mode 100644 index 6429880..0000000 --- a/shared/sx/ref/eval.sx +++ /dev/null @@ -1,1184 +0,0 @@ -;; ========================================================================== -;; eval.sx — Reference SX evaluator written in SX -;; -;; This is the canonical specification of SX evaluation semantics. -;; A thin bootstrap compiler per target reads this file and emits -;; a native evaluator (JavaScript, Python, Rust, etc.). -;; -;; The evaluator is written in a restricted subset of SX: -;; - defcomp, define, defmacro, lambda/fn -;; - if, when, cond, case, let, do, and, or -;; - map, filter, reduce, some, every? -;; - Primitives: list ops, string ops, arithmetic, predicates -;; - quote, quasiquote/unquote/splice-unquote -;; - Pattern matching via (case (type-of expr) ...) -;; -;; Platform-specific concerns (DOM rendering, async I/O, HTML emission) -;; are declared as interfaces — each target provides its own adapter. -;; ========================================================================== - - -;; -------------------------------------------------------------------------- -;; 1. Types -;; -------------------------------------------------------------------------- -;; -;; The evaluator operates on these value types: -;; -;; number — integer or float -;; string — double-quoted text -;; boolean — true / false -;; nil — singleton null -;; symbol — unquoted identifier (e.g. div, ~card, map) -;; keyword — colon-prefixed key (e.g. :class, :id) -;; list — ordered sequence (also used as code) -;; dict — string-keyed hash map -;; lambda — closure: {params, body, closure-env, name?} -;; macro — AST transformer: {params, rest-param, body, closure-env} -;; component — UI component: {name, params, has-children, body, closure-env} -;; island — reactive component: like component but with island flag -;; thunk — deferred eval for TCO: {expr, env} -;; -;; Each target must provide: -;; (type-of x) → one of the strings above -;; (make-lambda ...) → platform Lambda value -;; (make-component ..) → platform Component value -;; (make-island ...) → platform Island value (component + island flag) -;; (make-macro ...) → platform Macro value -;; (make-thunk ...) → platform Thunk value -;; -;; These are declared in platform.sx and implemented per target. -;; -------------------------------------------------------------------------- - - -;; -------------------------------------------------------------------------- -;; 2. Trampoline — tail-call optimization -;; -------------------------------------------------------------------------- - -(define trampoline - (fn ((val :as any)) - ;; Iteratively resolve thunks until we get an actual value. - ;; Each target implements thunk? and thunk-expr/thunk-env. - (let ((result val)) - (do - ;; Loop while result is a thunk - ;; Note: this is pseudo-iteration — bootstrap compilers convert - ;; this tail-recursive form to a while loop. - (if (thunk? result) - (trampoline (eval-expr (thunk-expr result) (thunk-env result))) - result))))) - - -;; -------------------------------------------------------------------------- -;; 3. Core evaluator -;; -------------------------------------------------------------------------- - -(define eval-expr - (fn (expr (env :as dict)) - (case (type-of expr) - - ;; --- literals pass through --- - "number" expr - "string" expr - "boolean" expr - "nil" nil - - ;; --- symbol lookup --- - "symbol" - (let ((name (symbol-name expr))) - (cond - (env-has? env name) (env-get env name) - (primitive? name) (get-primitive name) - (= name "true") true - (= name "false") false - (= name "nil") nil - :else (do (debug-log "Undefined symbol:" name "primitive?:" (primitive? name)) - (error (str "Undefined symbol: " name))))) - - ;; --- keyword → its string name --- - "keyword" (keyword-name expr) - - ;; --- dict literal --- - "dict" - (map-dict (fn (k v) (trampoline (eval-expr v env))) expr) - - ;; --- list = call or special form --- - "list" - (if (empty? expr) - (list) - (eval-list expr env)) - - ;; --- anything else passes through --- - :else expr))) - - -;; -------------------------------------------------------------------------- -;; 4. List evaluation — dispatch on head -;; -------------------------------------------------------------------------- - -(define eval-list - (fn (expr (env :as dict)) - (let ((head (first expr)) - (args (rest expr))) - - ;; If head isn't a symbol, lambda, or list → treat as data list - (if (not (or (= (type-of head) "symbol") - (= (type-of head) "lambda") - (= (type-of head) "list"))) - (map (fn (x) (trampoline (eval-expr x env))) expr) - - ;; Head is a symbol — check special forms, then function call - (if (= (type-of head) "symbol") - (let ((name (symbol-name head))) - (cond - ;; Special forms - (= name "if") (sf-if args env) - (= name "when") (sf-when args env) - (= name "cond") (sf-cond args env) - (= name "case") (sf-case args env) - (= name "and") (sf-and args env) - (= name "or") (sf-or args env) - (= name "let") (sf-let args env) - (= name "let*") (sf-let args env) - (= name "letrec") (sf-letrec args env) - (= name "lambda") (sf-lambda args env) - (= name "fn") (sf-lambda args env) - (= name "define") (sf-define args env) - (= name "defcomp") (sf-defcomp args env) - (= name "defisland") (sf-defisland args env) - (= name "defmacro") (sf-defmacro args env) - (= name "defstyle") (sf-defstyle args env) - (= name "defhandler") (sf-defhandler args env) - (= name "defpage") (sf-defpage args env) - (= name "defquery") (sf-defquery args env) - (= name "defaction") (sf-defaction args env) - (= name "deftype") (sf-deftype args env) - (= name "defeffect") (sf-defeffect args env) - (= name "begin") (sf-begin args env) - (= name "do") (sf-begin args env) - (= name "quote") (sf-quote args env) - (= name "quasiquote") (sf-quasiquote args env) - (= name "->") (sf-thread-first args env) - (= name "set!") (sf-set! args env) - (= name "reset") (sf-reset args env) - (= name "shift") (sf-shift args env) - (= name "dynamic-wind") (sf-dynamic-wind args env) - (= name "scope") (sf-scope args env) - (= name "provide") (sf-provide args env) - - ;; Higher-order forms - (= name "map") (ho-map args env) - (= name "map-indexed") (ho-map-indexed args env) - (= name "filter") (ho-filter args env) - (= name "reduce") (ho-reduce args env) - (= name "some") (ho-some args env) - (= name "every?") (ho-every args env) - (= name "for-each") (ho-for-each args env) - - ;; Macro expansion - (and (env-has? env name) (macro? (env-get env name))) - (let ((mac (env-get env name))) - (make-thunk (expand-macro mac args env) env)) - - ;; Render expression — delegate to active adapter (only when rendering). - (and (render-active?) (is-render-expr? expr)) - (render-expr expr env) - - ;; Fall through to function call - :else (eval-call head args env))) - - ;; Head is lambda or list — evaluate as function call - (eval-call head args env)))))) - - -;; -------------------------------------------------------------------------- -;; 5. Function / lambda / component call -;; -------------------------------------------------------------------------- - -(define eval-call - (fn (head (args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr head env))) - (evaluated-args (map (fn (a) (trampoline (eval-expr a env))) args))) - (cond - ;; Native callable (primitive function) - (and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f))) - (apply f evaluated-args) - - ;; Lambda - (lambda? f) - (call-lambda f evaluated-args env) - - ;; Component - (component? f) - (call-component f args env) - - ;; Island (reactive component) — same calling convention - (island? f) - (call-component f args env) - - :else (error (str "Not callable: " (inspect f))))))) - - -(define call-lambda - (fn ((f :as lambda) (args :as list) (caller-env :as dict)) - (let ((params (lambda-params f)) - (local (env-merge (lambda-closure f) caller-env))) - ;; Too many args is an error; too few pads with nil - (if (> (len args) (len params)) - (error (str (or (lambda-name f) "lambda") - " expects " (len params) " args, got " (len args))) - (do - ;; Bind params — provided args first, then nil for missing - (for-each - (fn (pair) (env-set! local (first pair) (nth pair 1))) - (zip params args)) - (for-each - (fn (p) (env-set! local p nil)) - (slice params (len args))) - ;; Return thunk for TCO - (make-thunk (lambda-body f) local)))))) - - -(define call-component - (fn ((comp :as component) (raw-args :as list) (env :as dict)) - ;; Parse keyword args and children from unevaluated arg list - (let ((parsed (parse-keyword-args raw-args env)) - (kwargs (first parsed)) - (children (nth parsed 1)) - (local (env-merge (component-closure comp) env))) - ;; Bind keyword params - (for-each - (fn (p) (env-set! local p (or (dict-get kwargs p) nil))) - (component-params comp)) - ;; Bind children if component accepts them - (when (component-has-children? comp) - (env-set! local "children" children)) - ;; Return thunk — body evaluated in local env - (make-thunk (component-body comp) local)))) - - -(define parse-keyword-args - (fn ((raw-args :as list) (env :as dict)) - ;; Walk args: keyword + next-val → kwargs dict, else → children list - (let ((kwargs (dict)) - (children (list)) - (i 0)) - ;; Iterative parse — bootstrap converts to while loop - (reduce - (fn (state arg) - (let ((idx (get state "i")) - (skip (get state "skip"))) - (if skip - ;; This arg was consumed as a keyword value - (assoc state "skip" false "i" (inc idx)) - (if (and (= (type-of arg) "keyword") - (< (inc idx) (len raw-args))) - ;; Keyword: evaluate next arg and store - (do - (dict-set! kwargs (keyword-name arg) - (trampoline (eval-expr (nth raw-args (inc idx)) env))) - (assoc state "skip" true "i" (inc idx))) - ;; Positional: evaluate and add to children - (do - (append! children (trampoline (eval-expr arg env))) - (assoc state "i" (inc idx))))))) - (dict "i" 0 "skip" false) - raw-args) - (list kwargs children)))) - - -;; -------------------------------------------------------------------------- -;; 6. Special forms -;; -------------------------------------------------------------------------- - -(define sf-if - (fn ((args :as list) (env :as dict)) - (let ((condition (trampoline (eval-expr (first args) env)))) - (if (and condition (not (nil? condition))) - (make-thunk (nth args 1) env) - (if (> (len args) 2) - (make-thunk (nth args 2) env) - nil))))) - - -(define sf-when - (fn ((args :as list) (env :as dict)) - (let ((condition (trampoline (eval-expr (first args) env)))) - (if (and condition (not (nil? condition))) - (do - ;; Evaluate all but last for side effects - (for-each - (fn (e) (trampoline (eval-expr e env))) - (slice args 1 (dec (len args)))) - ;; Last is tail position - (make-thunk (last args) env)) - nil)))) - - -;; cond-scheme? — check if ALL clauses are 2-element lists (scheme-style). -;; Checking only the first arg is ambiguous — (nil? x) is a 2-element -;; function call, not a scheme clause ((test body)). -(define cond-scheme? - (fn ((clauses :as list)) - (every? (fn (c) (and (= (type-of c) "list") (= (len c) 2))) - clauses))) - -(define sf-cond - (fn ((args :as list) (env :as dict)) - (if (cond-scheme? args) - (sf-cond-scheme args env) - (sf-cond-clojure args env)))) - -(define sf-cond-scheme - (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"))) - (make-thunk body env) - (if (trampoline (eval-expr test env)) - (make-thunk body env) - (sf-cond-scheme (rest clauses) env))))))) - -(define sf-cond-clojure - (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")))) - (make-thunk body env) - (if (trampoline (eval-expr test env)) - (make-thunk body env) - (sf-cond-clojure (slice clauses 2) env))))))) - - -(define sf-case - (fn ((args :as list) (env :as dict)) - (let ((match-val (trampoline (eval-expr (first args) env))) - (clauses (rest args))) - (sf-case-loop match-val clauses env)))) - -(define sf-case-loop - (fn (match-val (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")))) - (make-thunk body env) - (if (= match-val (trampoline (eval-expr test env))) - (make-thunk body env) - (sf-case-loop match-val (slice clauses 2) env))))))) - - -(define sf-and - (fn ((args :as list) (env :as dict)) - (if (empty? args) - true - (let ((val (trampoline (eval-expr (first args) env)))) - (if (not val) - val - (if (= (len args) 1) - val - (sf-and (rest args) env))))))) - - -(define sf-or - (fn ((args :as list) (env :as dict)) - (if (empty? args) - false - (let ((val (trampoline (eval-expr (first args) env)))) - (if val - val - (sf-or (rest args) env)))))) - - -(define sf-let - (fn ((args :as list) (env :as dict)) - ;; Detect named let: (let name ((x 0) ...) body) - ;; If first arg is a symbol, delegate to sf-named-let. - (if (= (type-of (first args)) "symbol") - (sf-named-let args env) - (let ((bindings (first args)) - (body (rest args)) - (local (env-extend env))) - ;; Parse bindings — support both ((name val) ...) and (name val name val ...) - (if (and (= (type-of (first bindings)) "list") - (= (len (first bindings)) 2)) - ;; Scheme-style - (for-each - (fn (binding) - (let ((vname (if (= (type-of (first binding)) "symbol") - (symbol-name (first binding)) - (first binding)))) - (env-set! local vname (trampoline (eval-expr (nth binding 1) local))))) - bindings) - ;; Clojure-style - (let ((i 0)) - (reduce - (fn (acc pair-idx) - (let ((vname (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") - (symbol-name (nth bindings (* pair-idx 2))) - (nth bindings (* pair-idx 2)))) - (val-expr (nth bindings (inc (* pair-idx 2))))) - (env-set! local vname (trampoline (eval-expr val-expr local))))) - nil - (range 0 (/ (len bindings) 2))))) - ;; Evaluate body — last expression in tail position - (for-each - (fn (e) (trampoline (eval-expr e local))) - (slice body 0 (dec (len body)))) - (make-thunk (last body) local))))) - - -;; Named let: (let name ((x 0) (y 1)) body...) -;; Desugars to a self-recursive lambda called with initial values. -;; The loop name is bound in the body so recursive calls produce TCO thunks. -(define sf-named-let - (fn ((args :as list) (env :as dict)) - (let ((loop-name (symbol-name (first args))) - (bindings (nth args 1)) - (body (slice args 2)) - (params (list)) - (inits (list))) - ;; Extract param names and init expressions - (if (and (= (type-of (first bindings)) "list") - (= (len (first bindings)) 2)) - ;; Scheme-style: ((x 0) (y 1)) - (for-each - (fn (binding) - (append! params (if (= (type-of (first binding)) "symbol") - (symbol-name (first binding)) - (first binding))) - (append! inits (nth binding 1))) - bindings) - ;; Clojure-style: (x 0 y 1) - (reduce - (fn (acc pair-idx) - (do - (append! params (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") - (symbol-name (nth bindings (* pair-idx 2))) - (nth bindings (* pair-idx 2)))) - (append! inits (nth bindings (inc (* pair-idx 2)))))) - nil - (range 0 (/ (len bindings) 2)))) - ;; Build loop body (wrap in begin if multiple exprs) - (let ((loop-body (if (= (len body) 1) (first body) - (cons (make-symbol "begin") body))) - (loop-fn (make-lambda params loop-body env))) - ;; Self-reference: loop can call itself by name - (set-lambda-name! loop-fn loop-name) - (env-set! (lambda-closure loop-fn) loop-name loop-fn) - ;; Evaluate initial values in enclosing env, then call - (let ((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits))) - (call-lambda loop-fn init-vals env)))))) - - -(define sf-lambda - (fn ((args :as list) (env :as dict)) - (let ((params-expr (first args)) - (body-exprs (rest args)) - (body (if (= (len body-exprs) 1) - (first body-exprs) - (cons (make-symbol "begin") body-exprs))) - (param-names (map (fn (p) - (cond - (= (type-of p) "symbol") - (symbol-name p) - ;; Annotated param: (name :as type) → extract name - (and (= (type-of p) "list") - (= (len p) 3) - (= (type-of (nth p 1)) "keyword") - (= (keyword-name (nth p 1)) "as")) - (symbol-name (first p)) - :else p)) - params-expr))) - (make-lambda param-names body env)))) - - -(define sf-define - (fn ((args :as list) (env :as dict)) - ;; Detect :effects keyword: (define name :effects [...] value) - (let ((name-sym (first args)) - (has-effects (and (>= (len args) 4) - (= (type-of (nth args 1)) "keyword") - (= (keyword-name (nth args 1)) "effects"))) - (val-idx (if (and (>= (len args) 4) - (= (type-of (nth args 1)) "keyword") - (= (keyword-name (nth args 1)) "effects")) - 3 1)) - (value (trampoline (eval-expr (nth args val-idx) env)))) - (when (and (lambda? value) (nil? (lambda-name value))) - (set-lambda-name! value (symbol-name name-sym))) - (env-set! env (symbol-name name-sym) value) - ;; Store effect annotation if declared - (when has-effects - (let ((effects-raw (nth args 2)) - (effect-list (if (= (type-of effects-raw) "list") - (map (fn (e) (if (= (type-of e) "symbol") - (symbol-name e) (str e))) - effects-raw) - (list (str effects-raw)))) - (effect-anns (if (env-has? env "*effect-annotations*") - (env-get env "*effect-annotations*") - (dict)))) - (dict-set! effect-anns (symbol-name name-sym) effect-list) - (env-set! env "*effect-annotations*" effect-anns))) - value))) - - -(define sf-defcomp - (fn ((args :as list) (env :as dict)) - ;; (defcomp ~name (params) [:affinity :client|:server] body) - ;; Body is always the last element. Optional keyword annotations - ;; may appear between the params list and the body. - (let ((name-sym (first args)) - (params-raw (nth args 1)) - (body (last args)) - (comp-name (strip-prefix (symbol-name name-sym) "~")) - (parsed (parse-comp-params params-raw)) - (params (first parsed)) - (has-children (nth parsed 1)) - (param-types (nth parsed 2)) - (affinity (defcomp-kwarg args "affinity" "auto"))) - (let ((comp (make-component comp-name params has-children body env affinity)) - (effects (defcomp-kwarg args "effects" nil))) - ;; Store type annotations if any were declared - (when (and (not (nil? param-types)) - (not (empty? (keys param-types)))) - (component-set-param-types! comp param-types)) - ;; Store effect annotation if declared - (when (not (nil? effects)) - (let ((effect-list (if (= (type-of effects) "list") - (map (fn (e) (if (= (type-of e) "symbol") - (symbol-name e) (str e))) - effects) - (list (str effects)))) - (effect-anns (if (env-has? env "*effect-annotations*") - (env-get env "*effect-annotations*") - (dict)))) - (dict-set! effect-anns (symbol-name name-sym) effect-list) - (env-set! env "*effect-annotations*" effect-anns))) - (env-set! env (symbol-name name-sym) comp) - comp)))) - -(define defcomp-kwarg - (fn ((args :as list) (key :as string) default) - ;; Search for :key value between params (index 2) and body (last). - (let ((end (- (len args) 1)) - (result default)) - (for-each - (fn (i) - (when (and (= (type-of (nth args i)) "keyword") - (= (keyword-name (nth args i)) key) - (< (+ i 1) end)) - (let ((val (nth args (+ i 1)))) - (set! result (if (= (type-of val) "keyword") - (keyword-name val) val))))) - (range 2 end 1)) - result))) - -(define parse-comp-params - (fn ((params-expr :as list)) - ;; Parse (&key param1 param2 &children) → (params has-children param-types) - ;; Also accepts &rest as synonym for &children. - ;; Supports typed params: (name :as type) — a 3-element list where - ;; the second element is the keyword :as. Unannotated params get no - ;; type entry. param-types is a dict {name → type-expr} or empty dict. - (let ((params (list)) - (param-types (dict)) - (has-children false) - (in-key false)) - (for-each - (fn (p) - (if (and (= (type-of p) "list") - (= (len p) 3) - (= (type-of (first p)) "symbol") - (= (type-of (nth p 1)) "keyword") - (= (keyword-name (nth p 1)) "as")) - ;; Typed param: (name :as type) - (let ((name (symbol-name (first p))) - (ptype (nth p 2))) - ;; Convert type to string if it's a symbol - (let ((type-val (if (= (type-of ptype) "symbol") - (symbol-name ptype) - ptype))) - (when (not has-children) - (append! params name) - (dict-set! param-types name type-val)))) - ;; Untyped param or marker - (when (= (type-of p) "symbol") - (let ((name (symbol-name p))) - (cond - (= name "&key") (set! in-key true) - (= name "&rest") (set! has-children true) - (= name "&children") (set! has-children true) - has-children nil ;; skip params after &children/&rest - in-key (append! params name) - :else (append! params name)))))) - params-expr) - (list params has-children param-types)))) - - -(define sf-defisland - (fn ((args :as list) (env :as dict)) - ;; (defisland ~name (params) body) - ;; Like defcomp but creates an island (reactive component). - ;; Islands have the same calling convention as components but - ;; render with a reactive context on the client. - (let ((name-sym (first args)) - (params-raw (nth args 1)) - (body (last args)) - (comp-name (strip-prefix (symbol-name name-sym) "~")) - (parsed (parse-comp-params params-raw)) - (params (first parsed)) - (has-children (nth parsed 1))) - (let ((island (make-island comp-name params has-children body env))) - (env-set! env (symbol-name name-sym) island) - island)))) - - -(define sf-defmacro - (fn ((args :as list) (env :as dict)) - (let ((name-sym (first args)) - (params-raw (nth args 1)) - (body (nth args 2)) - (parsed (parse-macro-params params-raw)) - (params (first parsed)) - (rest-param (nth parsed 1))) - (let ((mac (make-macro params rest-param body env (symbol-name name-sym)))) - (env-set! env (symbol-name name-sym) mac) - mac)))) - -(define parse-macro-params - (fn ((params-expr :as list)) - ;; Parse (a b &rest rest) → ((a b) rest) - (let ((params (list)) - (rest-param nil)) - (reduce - (fn (state p) - (if (and (= (type-of p) "symbol") (= (symbol-name p) "&rest")) - (assoc state "in-rest" true) - (if (get state "in-rest") - (do (set! rest-param (if (= (type-of p) "symbol") - (symbol-name p) p)) - state) - (do (append! params (if (= (type-of p) "symbol") - (symbol-name p) p)) - state)))) - (dict "in-rest" false) - params-expr) - (list params rest-param)))) - - -(define sf-defstyle - (fn ((args :as list) (env :as dict)) - ;; (defstyle name expr) — bind name to evaluated expr (string, function, etc.) - (let ((name-sym (first args)) - (value (trampoline (eval-expr (nth args 1) env)))) - (env-set! env (symbol-name name-sym) value) - value))) - - -;; -- deftype helpers (must be in eval.sx, not types.sx, because -;; sf-deftype is always compiled but types.sx is a spec module) -- - -(define make-type-def - (fn ((name :as string) (params :as list) body) - {:name name :params params :body body})) - -(define normalize-type-body - (fn (body) - ;; Convert AST type expressions to type representation. - ;; Symbols → strings, (union ...) → (or ...), dict keys → strings. - (cond - (nil? body) "nil" - (= (type-of body) "symbol") - (symbol-name body) - (= (type-of body) "string") - body - (= (type-of body) "keyword") - (keyword-name body) - (= (type-of body) "dict") - ;; Record type — normalize values - (map-dict (fn (k v) (normalize-type-body v)) body) - (= (type-of body) "list") - (if (empty? body) "any" - (let ((head (first body))) - (let ((head-name (if (= (type-of head) "symbol") - (symbol-name head) (str head)))) - ;; (union a b) → (or a b) - (if (= head-name "union") - (cons "or" (map normalize-type-body (rest body))) - ;; (or a b), (list-of t), (-> ...) etc. - (cons head-name (map normalize-type-body (rest body))))))) - :else (str body)))) - -(define sf-deftype - (fn ((args :as list) (env :as dict)) - ;; (deftype name body) or (deftype (name a b ...) body) - (let ((name-or-form (first args)) - (body-expr (nth args 1)) - (type-name nil) - (type-params (list))) - ;; Parse name — symbol or (symbol params...) - (if (= (type-of name-or-form) "symbol") - (set! type-name (symbol-name name-or-form)) - (when (= (type-of name-or-form) "list") - (set! type-name (symbol-name (first name-or-form))) - (set! type-params - (map (fn (p) (if (= (type-of p) "symbol") - (symbol-name p) (str p))) - (rest name-or-form))))) - ;; Normalize and store in *type-registry* - (let ((body (normalize-type-body body-expr)) - (registry (if (env-has? env "*type-registry*") - (env-get env "*type-registry*") - (dict)))) - (dict-set! registry type-name - (make-type-def type-name type-params body)) - (env-set! env "*type-registry*" registry) - nil)))) - - -(define sf-defeffect - (fn ((args :as list) (env :as dict)) - ;; (defeffect name) — register an effect name - (let ((effect-name (if (= (type-of (first args)) "symbol") - (symbol-name (first args)) - (str (first args)))) - (registry (if (env-has? env "*effect-registry*") - (env-get env "*effect-registry*") - (list)))) - (when (not (contains? registry effect-name)) - (append! registry effect-name)) - (env-set! env "*effect-registry*" registry) - nil))) - - -(define sf-begin - (fn ((args :as list) (env :as dict)) - (if (empty? args) - nil - (do - (for-each - (fn (e) (trampoline (eval-expr e env))) - (slice args 0 (dec (len args)))) - (make-thunk (last args) env))))) - - -(define sf-quote - (fn ((args :as list) (env :as dict)) - (if (empty? args) nil (first args)))) - - -(define sf-quasiquote - (fn ((args :as list) (env :as dict)) - (qq-expand (first args) env))) - -(define qq-expand - (fn (template (env :as dict)) - (if (not (= (type-of template) "list")) - template - (if (empty? template) - (list) - (let ((head (first template))) - (if (and (= (type-of head) "symbol") (= (symbol-name head) "unquote")) - (trampoline (eval-expr (nth template 1) env)) - ;; Walk children, handling splice-unquote - (reduce - (fn (result item) - (if (and (= (type-of item) "list") - (= (len item) 2) - (= (type-of (first item)) "symbol") - (= (symbol-name (first item)) "splice-unquote")) - (let ((spliced (trampoline (eval-expr (nth item 1) env)))) - (if (= (type-of spliced) "list") - (concat result spliced) - (if (nil? spliced) result (concat result (list spliced))))) - (concat result (list (qq-expand item env))))) - (list) - template))))))) - - -(define sf-thread-first - (fn ((args :as list) (env :as dict)) - (let ((val (trampoline (eval-expr (first args) env)))) - (reduce - (fn (result form) - (if (= (type-of form) "list") - (let ((f (trampoline (eval-expr (first form) env))) - (rest-args (map (fn (a) (trampoline (eval-expr a env))) - (rest form))) - (all-args (cons result rest-args))) - (cond - (and (callable? f) (not (lambda? f))) - (apply f all-args) - (lambda? f) - (trampoline (call-lambda f all-args env)) - :else (error (str "-> form not callable: " (inspect f))))) - (let ((f (trampoline (eval-expr form env)))) - (cond - (and (callable? f) (not (lambda? f))) - (f result) - (lambda? f) - (trampoline (call-lambda f (list result) env)) - :else (error (str "-> form not callable: " (inspect f))))))) - val - (rest args))))) - - -(define sf-set! - (fn ((args :as list) (env :as dict)) - (let ((name (symbol-name (first args))) - (value (trampoline (eval-expr (nth args 1) env)))) - (env-set! env name value) - value))) - - -;; -------------------------------------------------------------------------- -;; 6c. letrec — mutually recursive local bindings -;; -------------------------------------------------------------------------- -;; -;; (letrec ((even? (fn (n) (if (= n 0) true (odd? (- n 1))))) -;; (odd? (fn (n) (if (= n 0) false (even? (- n 1)))))) -;; (even? 10)) -;; -;; All bindings are first set to nil in the local env, then all values -;; are evaluated (so they can see each other's names), then lambda -;; closures are patched to include the final bindings. -;; -------------------------------------------------------------------------- - -(define sf-letrec - (fn ((args :as list) (env :as dict)) - (let ((bindings (first args)) - (body (rest args)) - (local (env-extend env)) - (names (list)) - (val-exprs (list))) - ;; First pass: bind all names to nil - (if (and (= (type-of (first bindings)) "list") - (= (len (first bindings)) 2)) - ;; Scheme-style - (for-each - (fn (binding) - (let ((vname (if (= (type-of (first binding)) "symbol") - (symbol-name (first binding)) - (first binding)))) - (append! names vname) - (append! val-exprs (nth binding 1)) - (env-set! local vname nil))) - bindings) - ;; Clojure-style - (reduce - (fn (acc pair-idx) - (let ((vname (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") - (symbol-name (nth bindings (* pair-idx 2))) - (nth bindings (* pair-idx 2)))) - (val-expr (nth bindings (inc (* pair-idx 2))))) - (append! names vname) - (append! val-exprs val-expr) - (env-set! local vname nil))) - nil - (range 0 (/ (len bindings) 2)))) - ;; Second pass: evaluate values (they can see each other's names) - (let ((values (map (fn (e) (trampoline (eval-expr e local))) val-exprs))) - ;; Bind final values - (for-each - (fn (pair) (env-set! local (first pair) (nth pair 1))) - (zip names values)) - ;; Patch lambda closures so they see the final bindings - (for-each - (fn (val) - (when (lambda? val) - (for-each - (fn (n) (env-set! (lambda-closure val) n (env-get local n))) - names))) - values)) - ;; Evaluate body - (for-each - (fn (e) (trampoline (eval-expr e local))) - (slice body 0 (dec (len body)))) - (make-thunk (last body) local)))) - - -;; -------------------------------------------------------------------------- -;; 6d. dynamic-wind — entry/exit guards -;; -------------------------------------------------------------------------- -;; -;; (dynamic-wind before-thunk body-thunk after-thunk) -;; -;; All three are zero-argument functions (thunks): -;; 1. Call before-thunk -;; 2. Call body-thunk, capture result -;; 3. Call after-thunk (always, even on error) -;; 4. Return body result -;; -;; The wind stack is maintained so that when continuations jump across -;; dynamic-wind boundaries, the correct before/after thunks fire. -;; Without active continuations, this is equivalent to try/finally. -;; -;; Platform requirements: -;; (push-wind! before after) — push wind record onto stack -;; (pop-wind!) — pop wind record from stack -;; (call-thunk f env) — call a zero-arg function -;; -------------------------------------------------------------------------- - -(define sf-dynamic-wind - (fn ((args :as list) (env :as dict)) - (let ((before (trampoline (eval-expr (first args) env))) - (body (trampoline (eval-expr (nth args 1) env))) - (after (trampoline (eval-expr (nth args 2) env)))) - ;; Delegate to platform — needs try/finally for error safety - (dynamic-wind-call before body after env)))) - - -;; -------------------------------------------------------------------------- -;; 6a2. scope — unified render-time dynamic scope primitive -;; -------------------------------------------------------------------------- -;; -;; (scope name body...) or (scope name :value v body...) -;; Push a named scope with optional value and empty accumulator, -;; evaluate body, pop scope. Returns last body result. -;; -;; `provide` is sugar: (provide name value body...) = (scope name :value value body...) - -(define sf-scope - (fn ((args :as list) (env :as dict)) - (let ((name (trampoline (eval-expr (first args) env))) - (rest (slice args 1)) - (val nil) - (body-exprs nil)) - ;; Check for :value keyword - (if (and (>= (len rest) 2) (= (type-of (first rest)) "keyword") (= (keyword-name (first rest)) "value")) - (do (set! val (trampoline (eval-expr (nth rest 1) env))) - (set! body-exprs (slice rest 2))) - (set! body-exprs rest)) - (scope-push! name val) - (let ((result nil)) - (for-each (fn (e) (set! result (trampoline (eval-expr e env)))) body-exprs) - (scope-pop! name) - result)))) - - -;; provide — sugar for scope with a value -;; (provide name value body...) → (scope name :value value body...) - -(define sf-provide - (fn ((args :as list) (env :as dict)) - (let ((name (trampoline (eval-expr (first args) env))) - (val (trampoline (eval-expr (nth args 1) env))) - (body-exprs (slice args 2)) - (result nil)) - (scope-push! name val) - (for-each (fn (e) (set! result (trampoline (eval-expr e env)))) body-exprs) - (scope-pop! name) - result))) - - -;; -------------------------------------------------------------------------- -;; 6b. Macro expansion -;; -------------------------------------------------------------------------- - -(define expand-macro - (fn ((mac :as macro) (raw-args :as list) (env :as dict)) - (let ((local (env-merge (macro-closure mac) env))) - ;; Bind positional params (unevaluated) - (for-each - (fn (pair) - (env-set! local (first pair) - (if (< (nth pair 1) (len raw-args)) - (nth raw-args (nth pair 1)) - nil))) - (map-indexed (fn (i p) (list p i)) (macro-params mac))) - ;; Bind &rest param - (when (macro-rest-param mac) - (env-set! local (macro-rest-param mac) - (slice raw-args (len (macro-params mac))))) - ;; Evaluate body → new AST - (trampoline (eval-expr (macro-body mac) local))))) - - -;; -------------------------------------------------------------------------- -;; 7. Higher-order forms -;; -------------------------------------------------------------------------- - -;; call-fn: unified caller for HO forms — handles both Lambda and native callable -(define call-fn - (fn (f (args :as list) (env :as dict)) - (cond - (lambda? f) (trampoline (call-lambda f args env)) - (callable? f) (apply f args) - :else (error (str "Not callable in HO form: " (inspect f)))))) - -(define ho-map - (fn ((args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (map (fn (item) (call-fn f (list item) env)) coll)))) - -(define ho-map-indexed - (fn ((args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (map-indexed - (fn (i item) (call-fn f (list i item) env)) - coll)))) - -(define ho-filter - (fn ((args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (filter - (fn (item) (call-fn f (list item) env)) - coll)))) - -(define ho-reduce - (fn ((args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr (first args) env))) - (init (trampoline (eval-expr (nth args 1) env))) - (coll (trampoline (eval-expr (nth args 2) env)))) - (reduce - (fn (acc item) (call-fn f (list acc item) env)) - init - coll)))) - -(define ho-some - (fn ((args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (some - (fn (item) (call-fn f (list item) env)) - coll)))) - -(define ho-every - (fn ((args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (every? - (fn (item) (call-fn f (list item) env)) - coll)))) - - -(define ho-for-each - (fn ((args :as list) (env :as dict)) - (let ((f (trampoline (eval-expr (first args) env))) - (coll (trampoline (eval-expr (nth args 1) env)))) - (for-each - (fn (item) (call-fn f (list item) env)) - coll)))) - - -;; -------------------------------------------------------------------------- -;; 8. Primitives — pure functions available in all targets -;; -------------------------------------------------------------------------- -;; These are the ~80 built-in functions. Each target implements them -;; natively but they MUST have identical semantics. This section serves -;; as the specification — bootstrap compilers use it for reference. -;; -;; Primitives are NOT defined here as SX lambdas (that would be circular). -;; Instead, this is a declarative registry that bootstrap compilers read. -;; -------------------------------------------------------------------------- - -;; See primitives.sx for the full specification. - - -;; -------------------------------------------------------------------------- -;; 9. Platform interface — must be provided by each target -;; -------------------------------------------------------------------------- -;; -;; Type inspection: -;; (type-of x) → "number" | "string" | "boolean" | "nil" -;; | "symbol" | "keyword" | "list" | "dict" -;; | "lambda" | "component" | "macro" | "thunk" -;; | "spread" -;; (symbol-name sym) → string -;; (keyword-name kw) → string -;; -;; Constructors: -;; (make-lambda params body env) → Lambda -;; (make-component name params has-children body env affinity) → Component -;; (make-macro params rest-param body env name) → Macro -;; (make-thunk expr env) → Thunk -;; -;; Accessors: -;; (lambda-params f) → list of strings -;; (lambda-body f) → expr -;; (lambda-closure f) → env -;; (lambda-name f) → string or nil -;; (set-lambda-name! f n) → void -;; (component-params c) → list of strings -;; (component-body c) → expr -;; (component-closure c) → env -;; (component-has-children? c) → boolean -;; (component-affinity c) → "auto" | "client" | "server" -;; -;; (make-island name params has-children body env) → Island -;; (island? x) → boolean -;; ;; Islands reuse component accessors: component-params, component-body, etc. -;; -;; (make-spread attrs) → Spread (attrs dict injected onto parent element) -;; (spread? x) → boolean -;; (spread-attrs s) → dict -;; -;; (macro-params m) → list of strings -;; (macro-rest-param m) → string or nil -;; (macro-body m) → expr -;; (macro-closure m) → env -;; (thunk? x) → boolean -;; (thunk-expr t) → expr -;; (thunk-env t) → env -;; -;; Predicates: -;; (callable? x) → boolean (native function or lambda) -;; (lambda? x) → boolean -;; (component? x) → boolean -;; (island? x) → boolean -;; (macro? x) → boolean -;; (primitive? name) → boolean (is name a registered primitive?) -;; (get-primitive name) → function -;; -;; Environment: -;; (env-has? env name) → boolean -;; (env-get env name) → value -;; (env-set! env name val) → void (mutating) -;; (env-extend env) → new env inheriting from env -;; (env-merge base overlay) → new env with overlay on top -;; -;; Mutation helpers (for parse-keyword-args): -;; (dict-set! d key val) → void -;; (dict-get d key) → value or nil -;; (append! lst val) → void (mutating append) -;; -;; Error: -;; (error msg) → raise/throw with message -;; (inspect x) → string representation for debugging -;; -;; Utility: -;; (strip-prefix s prefix) → string with prefix removed (or s unchanged) -;; (apply f args) → call f with args list -;; (zip lists...) → list of tuples -;; -;; -;; Dynamic wind (for dynamic-wind): -;; (push-wind! before after) → void (push wind record onto stack) -;; (pop-wind!) → void (pop wind record from stack) -;; (call-thunk f env) → value (call a zero-arg function) -;; -;; Render-time accumulators: -;; (collect! bucket value) → void (add to named bucket, deduplicated) -;; (collected bucket) → list (all values in bucket) -;; (clear-collected! bucket) → void (empty the bucket) -;; -------------------------------------------------------------------------- diff --git a/shared/sx/ref/frames.sx b/shared/sx/ref/frames.sx deleted file mode 100644 index 05e27c3..0000000 --- a/shared/sx/ref/frames.sx +++ /dev/null @@ -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)))) diff --git a/shared/sx/ref/parser.sx b/shared/sx/ref/parser.sx deleted file mode 100644 index 2fb9b2d..0000000 --- a/shared/sx/ref/parser.sx +++ /dev/null @@ -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 -;; -------------------------------------------------------------------------- diff --git a/shared/sx/ref/primitives.sx b/shared/sx/ref/primitives.sx deleted file mode 100644 index ec5a7cb..0000000 --- a/shared/sx/ref/primitives.sx +++ /dev/null @@ -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.") diff --git a/shared/sx/ref/render.sx b/shared/sx/ref/render.sx deleted file mode 100644 index 0293da5..0000000 --- a/shared/sx/ref/render.sx +++ /dev/null @@ -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) -;; -------------------------------------------------------------------------- diff --git a/shared/sx/ref/special-forms.sx b/shared/sx/ref/special-forms.sx deleted file mode 100644 index 8c880af..0000000 --- a/shared/sx/ref/special-forms.sx +++ /dev/null @@ -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))") diff --git a/shared/sx/ref/types.sx b/shared/sx/ref/types.sx deleted file mode 100644 index 9ed0073..0000000 --- a/shared/sx/ref/types.sx +++ /dev/null @@ -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 } - -(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. -;; -;; -------------------------------------------------------------------------- diff --git a/spec/boundary-core.sx b/spec/boundary-core.sx deleted file mode 100644 index 9f652d9..0000000 --- a/spec/boundary-core.sx +++ /dev/null @@ -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.") diff --git a/spec/test-cek.sx b/spec/test-cek.sx deleted file mode 100644 index 52ae7b9..0000000 --- a/spec/test-cek.sx +++ /dev/null @@ -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))))")))) diff --git a/spec/test-continuations.sx b/spec/test-continuations.sx deleted file mode 100644 index 0177e70..0000000 --- a/spec/test-continuations.sx +++ /dev/null @@ -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)))))))) diff --git a/spec/test-eval.sx b/spec/test-eval.sx deleted file mode 100644 index 33885f7..0000000 --- a/spec/test-eval.sx +++ /dev/null @@ -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?) diff --git a/spec/test-framework.sx b/spec/test-framework.sx deleted file mode 100644 index 3a80ca0..0000000 --- a/spec/test-framework.sx +++ /dev/null @@ -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")))) diff --git a/spec/test-parser.sx b/spec/test-parser.sx deleted file mode 100644 index 640f0ce..0000000 --- a/spec/test-parser.sx +++ /dev/null @@ -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))))) diff --git a/spec/test-render.sx b/spec/test-render.sx deleted file mode 100644 index 1097d7a..0000000 --- a/spec/test-render.sx +++ /dev/null @@ -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 "
hello
" - (render-html "(div \"hello\")"))) - - (deftest "nested elements" - (assert-equal "
hi
" - (render-html "(div (span \"hi\"))"))) - - (deftest "multiple children" - (assert-equal "

a

b

" - (render-html "(div (p \"a\") (p \"b\"))"))) - - (deftest "text content" - (assert-equal "

hello world

" - (render-html "(p \"hello\" \" world\")"))) - - (deftest "number content" - (assert-equal "42" - (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 "
" (render-html "(br)"))) - - (deftest "img with attrs" - (let ((html (render-html "(img :src \"pic.jpg\" :alt \"A pic\")"))) - (assert-true (string-contains? html "")) - ;; void elements should not have a closing tag - (assert-false (string-contains? html "")))) - - (deftest "input is self-closing" - (let ((html (render-html "(input :type \"text\" :name \"q\")"))) - (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 "

a

b

" - (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 \"\")"))) - (assert-false (string-contains? html "