diff --git a/spec/evaluator.sx b/spec/evaluator.sx index 05532022..2823bd62 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -1,47 +1,67 @@ +;; Construct a CEK state: expression to evaluate, env, continuation (define make-cek-state (fn (control env kont) {:control control :env env :kont kont :value nil :phase "eval"})) +;; Construct a CEK value state: computation complete, result ready (define make-cek-value (fn (value env kont) {:control nil :env env :kont kont :value value :phase "continue"})) +;; True if state is a terminal value (no more steps needed) (define cek-terminal? (fn (state) (and (= (get state "phase") "continue") (empty? (get state "kont"))))) +;; Extract the control expression from a CEK state (define cek-control (fn (s) (get s "control"))) +;; Extract the environment from a CEK state (define cek-env (fn (s) (get s "env"))) +;; Extract the continuation stack from a CEK state (define cek-kont (fn (s) (get s "kont"))) +;; Return state phase: "eval" or "value" (define cek-phase (fn (s) (get s "phase"))) +;; Extract the result value from a terminal CEK state (define cek-value (fn (s) (get s "value"))) +;; Frame for if: holds then/else branches, awaiting test result (define make-if-frame (fn (then-expr else-expr env) {:else else-expr :env env :type "if" :then then-expr})) +;; Frame for when: holds body, awaiting test result (define make-when-frame (fn (body-exprs env) {:body body-exprs :env env :type "when"})) +;; Frame for begin/do: holds remaining expressions (define make-begin-frame (fn (remaining env) {:env env :type "begin" :remaining remaining})) +;; Frame for let: holds remaining bindings and body (define make-let-frame (fn (name remaining body local) {:body body :env local :type "let" :remaining remaining :name name})) +;; Frame for define: holds name, awaiting value (define make-define-frame (fn (name env has-effects effect-list) {:env env :effect-list effect-list :has-effects has-effects :type "define" :name name})) +;; Frame for set!: holds name, awaiting new value (define make-set-frame (fn (name env) {:env env :type "set" :name name})) +;; Frame for function call: accumulates evaluated arguments (define make-arg-frame (fn (f evaled remaining env raw-args head-name) {:env env :head-name (or head-name nil) :evaled evaled :type "arg" :f f :remaining remaining :raw-args raw-args})) +;; Frame for call dispatch: holds function and args (define make-call-frame (fn (f args env) {:args args :env env :type "call" :f f})) +;; Frame for cond: holds remaining clauses (define make-cond-frame (fn (remaining env scheme?) {:scheme scheme? :env env :type "cond" :remaining remaining})) +;; Frame for case: holds match value and remaining clauses (define make-case-frame (fn (match-val remaining env) {:match-val match-val :env env :type "case" :remaining remaining})) +;; Frame for -> threading: holds remaining forms (define make-thread-frame (fn (remaining env) {:env env :type "thread" :remaining remaining})) +;; Insert threaded value as first arg in a form (define thread-insert-arg (fn @@ -53,52 +73,72 @@ fenv) (eval-expr (list form (list (quote quote) value)) fenv)))) +;; Frame for map: accumulates results over remaining items (define make-map-frame (fn (f remaining results env) {:indexed false :env env :results results :type "map" :f f :remaining remaining})) +;; Frame for map-indexed: like map but tracks index (define make-map-indexed-frame (fn (f remaining results env) {:indexed true :env env :results results :type "map" :f f :remaining remaining})) +;; Frame for filter: accumulates items passing predicate (define make-filter-frame (fn (f remaining results current-item env) {:current-item current-item :env env :results results :type "filter" :f f :remaining remaining})) +;; Frame for reduce: carries accumulator over remaining items (define make-reduce-frame (fn (f remaining env) {:env env :type "reduce" :f f :remaining remaining})) +;; Frame for for-each: side-effects over remaining items (define make-for-each-frame (fn (f remaining env) {:env env :type "for-each" :f f :remaining remaining})) +;; Frame for some: short-circuits on first truthy result (define make-some-frame (fn (f remaining env) {:env env :type "some" :f f :remaining remaining})) +;; Frame for every?: short-circuits on first falsy result (define make-every-frame (fn (f remaining env) {:env env :type "every" :f f :remaining remaining})) +;; Frame for scope: holds scope name, pops on completion (define make-scope-frame (fn (name remaining env) {:env env :type "scope" :remaining remaining :name name})) +;; Frame for provide: scope with a downward value (define make-provide-frame (fn (name value remaining env) {:env env :value value :type "provide" :remaining remaining :name name})) +;; Frame for scope accumulator: tracks emitted values (define make-scope-acc-frame (fn (name value remaining env) {:env env :value (or value nil) :type "scope-acc" :remaining remaining :emitted (list) :name name})) +;; Frame for reset: delimits continuation capture boundary (define make-reset-frame (fn (env) {:env env :type "reset"})) +;; Frame for dict literal: accumulates evaluated key-value pairs (define make-dict-frame (fn (remaining results env) {:env env :results results :type "dict" :remaining remaining})) +;; Frame for and: short-circuits on first falsy value (define make-and-frame (fn (remaining env) {:env env :type "and" :remaining remaining})) +;; Frame for or: short-circuits on first truthy value (define make-or-frame (fn (remaining env) {:env env :type "or" :remaining remaining})) +;; Frame for dynamic-wind: holds before/after thunks (define make-dynamic-wind-frame (fn (phase body-thunk after-thunk env) {:env env :phase phase :after-thunk after-thunk :type "dynamic-wind" :body-thunk body-thunk})) +;; Frame for reactive reset: delimits signal dependency tracking (define make-reactive-reset-frame (fn (env update-fn first-render?) {:first-render first-render? :update-fn update-fn :env env :type "reactive-reset"})) +;; Frame for deref: resolves signal value with dependency tracking (define make-deref-frame (fn (env) {:env env :type "deref"})) +;; Frame for higher-order setup: staged arg evaluation for map/filter/etc. (define make-ho-setup-frame (fn (ho-type remaining-args evaled-args env) {:ho-type ho-type :env env :evaled evaled-args :type "ho-setup" :remaining remaining-args})) +;; Frame for component trace: records component render tree (define make-comp-trace-frame (fn (name file) {:env file :type "comp-trace" :name name})) +;; Walk continuation stack collecting component trace entries (define kont-collect-comp-trace (fn @@ -113,12 +153,16 @@ (cons {:file (get frame "file") :name (get frame "name")} (kont-collect-comp-trace (rest kont))) (kont-collect-comp-trace (rest kont))))))) +;; Frame for handler-bind: condition handler scope (define make-handler-frame (fn (handlers remaining env) {:env env :type "handler" :f handlers :remaining remaining})) +;; Frame for restart-case: named restart scope (define make-restart-frame (fn (restarts remaining env) {:env env :type "restart" :f restarts :remaining remaining})) +;; Frame for signal return: restores saved continuation after handler (define make-signal-return-frame (fn (env saved-kont) {:env env :type "signal-return" :f saved-kont})) +;; Search handler list for one matching a condition type (define find-matching-handler (fn @@ -135,6 +179,7 @@ handler-fn (find-matching-handler (rest handlers) condition))))))) +;; Walk continuation stack looking for a matching handler frame (define kont-find-handler (fn @@ -154,6 +199,7 @@ match)) (kont-find-handler (rest kont) condition)))))) +;; Search restart list for one matching a name (define find-named-restart (fn @@ -168,6 +214,7 @@ entry (find-named-restart (rest restarts) name)))))) +;; Walk continuation stack looking for a named restart frame (define kont-find-restart (fn @@ -187,16 +234,22 @@ (list match frame (rest kont)))) (kont-find-restart (rest kont) name)))))) +;; Get the type tag of a continuation frame (define frame-type (fn (f) (get f "type"))) +;; Push a frame onto the continuation stack (define kont-push (fn (frame kont) (cons frame kont))) +;; Peek at the top frame of the continuation stack (define kont-top (fn (kont) (first kont))) +;; Pop the top frame, returning the rest of the stack (define kont-pop (fn (kont) (rest kont))) +;; True if the continuation stack has no frames (define kont-empty? (fn (kont) (empty? kont))) +;; Capture continuation frames up to the nearest reset delimiter (define kont-capture-to-reset (fn @@ -218,6 +271,7 @@ (scan (rest k) (append captured (list frame)))))))) (scan kont (list)))) +;; Walk stack looking for a provide frame with matching name (define kont-find-provide (fn @@ -234,6 +288,7 @@ frame (kont-find-provide (rest kont) name)))))) +;; Walk stack looking for a scope accumulator with matching name (define kont-find-scope-acc (fn @@ -250,6 +305,7 @@ frame (kont-find-scope-acc (rest kont) name)))))) +;; True if stack contains a reactive-reset frame (define has-reactive-reset-frame? (fn @@ -262,6 +318,7 @@ true (has-reactive-reset-frame? (rest kont)))))) +;; Capture frames up to the nearest reactive-reset delimiter (define kont-capture-to-reactive-reset (fn @@ -281,18 +338,23 @@ (scan (rest k) (append captured (list frame)))))))) (scan kont (list)))) +;; Registry of user-defined special forms (define *custom-special-forms* (dict)) +;; Register a function as a custom special form (define register-special-form! (fn ((name :as string) handler) (dict-set! *custom-special-forms* name handler))) +;; Function to check if a symbol is a renderable HTML tag (define *render-check* nil) +;; Function to render an HTML element (define *render-fn* nil) +;; Trampoline: repeatedly evaluate thunks until a non-thunk value (define trampoline (fn @@ -305,14 +367,19 @@ (trampoline (eval-expr (thunk-expr result) (thunk-env result))) result))))) +;; Flag: enable strict type checking mode (define *strict* false) +;; Enable or disable strict type checking (define set-strict! (fn (val) (set! *strict* val))) +;; Type specs for primitive function parameters (define *prim-param-types* nil) +;; Set the parameter type spec table for strict mode (define set-prim-param-types! (fn (types) (set! *prim-param-types* types))) +;; Check if a value matches a declared type (for strict mode) (define value-matches-type? (fn @@ -339,6 +406,7 @@ (slice expected-type 0 (- (string-length expected-type) 1)))) true))))) +;; Validate function arguments against declared types (define strict-check-args (fn @@ -408,8 +476,10 @@ (fn (i v) (list i v)) (slice args (len (or positional (list))))))))))))) +;; Evaluate an expression in an environment (CEK entry point) (define eval-expr (fn (expr (env :as dict)) nil)) +;; Call a lambda with evaluated args, binding params in closure env (define call-lambda (fn @@ -435,6 +505,7 @@ (slice params (len args))) (make-thunk (lambda-body f) local)))))) +;; Call a component with keyword args, binding params in closure env (define call-component (fn @@ -452,6 +523,7 @@ (env-bind! local "children" children)) (make-thunk (component-body comp) local)))) +;; Parse &key and &rest args from a component call (define parse-keyword-args (fn @@ -483,12 +555,14 @@ raw-args) (list kwargs children)))) +;; Detect if a cond uses scheme-style ((test body) ...) syntax (define cond-scheme? (fn ((clauses :as list)) (every? (fn (c) (and (= (type-of c) "list") (= (len c) 2))) clauses))) +;; True if a cond clause is the :else / else fallback (define is-else-clause? (fn @@ -499,6 +573,7 @@ (= (type-of test) "symbol") (or (= (symbol-name test) "else") (= (symbol-name test) ":else")))))) +;; Handle named let: (let name ((var val) ...) body) (define sf-named-let (fn @@ -546,6 +621,7 @@ ((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits))) (cek-call loop-fn init-vals)))))) +;; Construct a lambda value from params and body (define sf-lambda (fn @@ -575,6 +651,7 @@ params-expr))) (make-lambda param-names body env)))) +;; Handle defcomp: register a named component (define sf-defcomp (fn @@ -612,6 +689,7 @@ (env-bind! env (symbol-name name-sym) comp) comp)))) +;; Parse a single &key parameter with optional default (define defcomp-kwarg (fn @@ -634,6 +712,7 @@ (range 2 end 1)) result))) +;; Parse component parameter list (positional, &key, &rest) (define parse-comp-params (fn @@ -680,6 +759,7 @@ params-expr) (list params has-children param-types)))) +;; Handle defisland: register a reactive island component (define sf-defisland (fn @@ -705,6 +785,7 @@ (env-bind! env (symbol-name name-sym) island) island)))) +;; Handle defmacro: register a macro transformer (define sf-defmacro (fn @@ -721,6 +802,7 @@ (env-bind! env (symbol-name name-sym) mac) mac)))) +;; Parse macro parameter list (define parse-macro-params (fn @@ -749,6 +831,7 @@ params-expr) (list params rest-param)))) +;; Expand a quasiquote template, splicing unquoted values (define qq-expand (fn @@ -788,6 +871,7 @@ (list) template))))))) +;; Handle letrec: mutually recursive bindings (define sf-letrec (fn @@ -843,6 +927,7 @@ (slice body 0 (dec (len body)))) (make-thunk (last body) local)))) +;; CEK step for letrec continuation frame (define step-sf-letrec (fn @@ -851,6 +936,7 @@ ((thk (sf-letrec args env))) (make-cek-state (thunk-expr thk) (thunk-env thk) kont)))) +;; Handle dynamic-wind: before/body/after with guaranteed cleanup (define sf-dynamic-wind (fn @@ -861,6 +947,7 @@ (after (trampoline (eval-expr (nth args 2) env)))) (dynamic-wind-call before body after env)))) +;; Handle scope special form: push/pop named scope (define sf-scope (fn @@ -888,6 +975,7 @@ (scope-pop! name) result)))) +;; Handle provide: scope with a downward-propagating value (define sf-provide (fn @@ -904,6 +992,7 @@ (scope-pop! name) result))) +;; Expand a macro call: bind args, evaluate transformer body (define expand-macro (fn @@ -929,12 +1018,14 @@ (slice raw-args (len (macro-params mac))))) (trampoline (eval-expr (macro-body mac) local))))) +;; Run the CEK machine to completion, returning final value (define cek-run (fn (state) (if (cek-terminal? state) (cek-value state) (cek-run (cek-step state))))) +;; Single CEK machine step: eval or continue (define cek-step (fn @@ -944,6 +1035,7 @@ (step-eval state) (step-continue state)))) +;; Eval phase: dispatch on expression type (literal, symbol, list, dict) (define step-eval (fn @@ -1000,6 +1092,7 @@ (step-eval-list expr env kont)) :else (make-cek-value expr env kont))))) +;; Eval a list expression: check for special forms, macros, then call (define step-eval-list (fn @@ -1089,6 +1182,7 @@ :else (step-eval-call head args env kont))))) (step-eval-call head args env kont)))))) +;; Find matching clause in a match expression (define match-find-clause (fn @@ -1106,6 +1200,7 @@ (list local body) (match-find-clause val (rest clauses) env)))))) +;; Match a value against a pattern, returning bindings or nil (define match-pattern (fn @@ -1138,6 +1233,7 @@ pairs))) :else (= pattern value)))) +;; CEK step for match special form (define step-sf-match (fn @@ -1152,6 +1248,7 @@ (error (str "match: no clause matched " (inspect val))) (make-cek-state (nth result 1) (first result) kont)))))) +;; CEK step for handler-bind (condition system) (define step-sf-handler-bind (fn @@ -1175,6 +1272,7 @@ env (kont-push (make-handler-frame handlers (rest body) env) kont)))))) +;; CEK step for restart-case (condition system) (define step-sf-restart-case (fn @@ -1199,6 +1297,7 @@ env (kont-push (make-restart-frame restarts (list) env) kont))))) +;; CEK step for signal (raise a condition) (define step-sf-signal (fn @@ -1216,6 +1315,7 @@ (list condition) (kont-push (make-signal-return-frame env kont) kont)))))) +;; CEK step for invoke-restart (jump to named restart) (define step-sf-invoke-restart (fn @@ -1244,6 +1344,7 @@ (env-bind! restart-env (first params) restart-arg)) (make-cek-state body restart-env rest-kont))))))) +;; CEK step for if: push if-frame, evaluate test (define step-sf-if (fn @@ -1258,6 +1359,7 @@ env) kont)))) +;; CEK step for when: push when-frame, evaluate test (define step-sf-when (fn @@ -1267,6 +1369,7 @@ env (kont-push (make-when-frame (rest args) env) kont)))) +;; CEK step for begin/do: evaluate forms sequentially (define step-sf-begin (fn @@ -1282,6 +1385,7 @@ env (kont-push (make-begin-frame (rest args) env) kont)))))) +;; CEK step for let: evaluate first binding value (define step-sf-let (fn @@ -1326,6 +1430,7 @@ (make-let-frame vname rest-bindings body local) kont))))))))) +;; CEK step for define: evaluate value, bind in env (define step-sf-define (fn @@ -1364,6 +1469,7 @@ effect-list) kont))))) +;; CEK step for set!: evaluate value, mutate existing binding (define step-sf-set! (fn @@ -1373,6 +1479,7 @@ env (kont-push (make-set-frame (symbol-name (first args)) env) kont)))) +;; CEK step for and: short-circuit on falsy (define step-sf-and (fn @@ -1385,6 +1492,7 @@ env (kont-push (make-and-frame (rest args) env) kont))))) +;; CEK step for or: short-circuit on truthy (define step-sf-or (fn @@ -1397,6 +1505,7 @@ env (kont-push (make-or-frame (rest args) env) kont))))) +;; CEK step for cond: evaluate first test (define step-sf-cond (fn @@ -1430,6 +1539,7 @@ env (kont-push (make-cond-frame args env false) kont))))))))) +;; CEK step for case: evaluate match value (define step-sf-case (fn @@ -1439,6 +1549,7 @@ env (kont-push (make-case-frame nil (rest args) env) kont)))) +;; CEK step for ->: thread value through forms (define step-sf-thread-first (fn @@ -1448,10 +1559,12 @@ env (kont-push (make-thread-frame (rest args) env) kont)))) +;; CEK step for lambda/fn: capture closure (define step-sf-lambda (fn (args env kont) (make-cek-value (sf-lambda args env) env kont))) +;; CEK step for scope: push scope, evaluate body (define step-sf-scope (fn @@ -1478,6 +1591,7 @@ env (kont-push (make-scope-acc-frame name val (rest body) env) kont)))))) +;; CEK step for provide: push scoped value, evaluate body (define step-sf-provide (fn @@ -1494,6 +1608,7 @@ env (kont-push (make-provide-frame name val (rest body) env) kont)))))) +;; CEK step for context: read value from nearest enclosing scope (define step-sf-context (fn @@ -1511,6 +1626,7 @@ env kont)))) +;; CEK step for emit!: append value to scope accumulator (define step-sf-emit (fn @@ -1527,6 +1643,7 @@ (append (get frame "emitted") (list val)))) (make-cek-value nil env kont)))) +;; CEK step for emitted: read accumulated values from scope (define step-sf-emitted (fn @@ -1539,6 +1656,7 @@ env kont)))) +;; CEK step for reset: push delimiter frame, evaluate body (define step-sf-reset (fn @@ -1548,6 +1666,7 @@ env (kont-push (make-reset-frame env) kont)))) +;; CEK step for shift: capture continuation to reset, call handler (define step-sf-shift (fn @@ -1565,6 +1684,7 @@ (env-bind! shift-env k-name k) (make-cek-state body shift-env rest-kont)))))) +;; CEK step for deref: resolve signal with dependency tracking (define step-sf-deref (fn @@ -1574,6 +1694,7 @@ env (kont-push (make-deref-frame env) kont)))) +;; Dispatch a function call: native fn, lambda, component, or macro (define cek-call (fn @@ -1587,6 +1708,7 @@ (cek-run (continue-with-call f a (make-env) a (list))) :else nil)))) +;; Deref inside reactive context: capture deps via shift (define reactive-shift-deref (fn @@ -1611,6 +1733,7 @@ ((initial-kont (concat captured-frames (list reset-frame) remaining-kont))) (make-cek-value (signal-value sig) env initial-kont))))))) +;; Evaluate function position, set up arg evaluation frames (define step-eval-call (fn @@ -1622,6 +1745,7 @@ env (kont-push (make-arg-frame nil (list) args env args hname) kont))))) +;; True if name is a higher-order form (map, filter, reduce, etc.) (define ho-form-name? (fn @@ -1635,8 +1759,10 @@ (= name "every?") (= name "for-each")))) +;; True if a value is a function (lambda or native callable) (define ho-fn? (fn (v) (or (callable? v) (lambda? v)))) +;; Auto-detect data-first vs fn-first arg order for HO forms (define ho-swap-args (fn @@ -1653,6 +1779,7 @@ ((a (first evaled)) (b (nth evaled 1))) (if (and (not (ho-fn? a)) (ho-fn? b)) (list b a) evaled))))) +;; Dispatch a higher-order form after args are evaluated (define ho-setup-dispatch (fn @@ -1758,6 +1885,7 @@ (kont-push (make-for-each-frame f (rest coll) env) kont))))) (_ (error (str "Unknown HO type: " ho-type)))))))) +;; CEK step for map: apply fn to next item, accumulate (define step-ho-map (fn @@ -1767,6 +1895,7 @@ env (kont-push (make-ho-setup-frame "map" (rest args) (list) env) kont)))) +;; CEK step for map-indexed: like map with index arg (define step-ho-map-indexed (fn @@ -1778,6 +1907,7 @@ (make-ho-setup-frame "map-indexed" (rest args) (list) env) kont)))) +;; CEK step for filter: test next item, keep if truthy (define step-ho-filter (fn @@ -1787,6 +1917,7 @@ env (kont-push (make-ho-setup-frame "filter" (rest args) (list) env) kont)))) +;; CEK step for reduce: apply fn to accumulator and next item (define step-ho-reduce (fn @@ -1796,6 +1927,7 @@ env (kont-push (make-ho-setup-frame "reduce" (rest args) (list) env) kont)))) +;; CEK step for some: return first truthy result (define step-ho-some (fn @@ -1805,6 +1937,7 @@ env (kont-push (make-ho-setup-frame "some" (rest args) (list) env) kont)))) +;; CEK step for every?: return false on first falsy (define step-ho-every (fn @@ -1814,6 +1947,7 @@ env (kont-push (make-ho-setup-frame "every" (rest args) (list) env) kont)))) +;; CEK step for for-each: apply fn for side effects (define step-ho-for-each (fn @@ -1825,6 +1959,7 @@ (make-ho-setup-frame "for-each" (rest args) (list) env) kont)))) +;; Continue phase: pop frame, dispatch on frame type (define step-continue (fn @@ -2399,6 +2534,7 @@ ("comp-trace" (make-cek-value value env rest-k)) (_ (error (str "Unknown frame type: " ft))))))))) +;; Continue with a function call after args are evaluated (define continue-with-call (fn @@ -2460,6 +2596,7 @@ kont))) :else (error (str "Not callable: " (inspect f)))))) +;; Case dispatch: iterate clauses matching against value (define sf-case-step-loop (fn @@ -2479,20 +2616,24 @@ (make-cek-state body env kont) (sf-case-step-loop match-val (slice clauses 2) env kont)))))))) +;; Full CEK evaluation: create initial state, run to completion (define eval-expr-cek (fn (expr env) (cek-run (make-cek-state expr env (list))))) +;; Trampoline wrapper for CEK: handles thunks from eval-expr-cek (define trampoline-cek (fn (val) (if (thunk? val) (eval-expr-cek (thunk-expr val) (thunk-env val)) val))) +;; Evaluate an expression in an environment (CEK entry point) (define eval-expr (fn (expr (env :as dict)) (cek-run (make-cek-state expr env (list))))) +;; Trampoline: repeatedly evaluate thunks until a non-thunk value (define trampoline (fn