giles
d076fc1465
Previously defhandler routed to sf-define which tried to evaluate (&key ...) params as expressions. Now each form has its own spec with parse-key-params and platform constructors. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
774 lines
28 KiB
Plaintext
774 lines
28 KiB
Plaintext
;; ==========================================================================
|
|
;; 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}
|
|
;; 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-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)
|
|
;; 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)
|
|
(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 (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)
|
|
(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 "lambda") (sf-lambda args env)
|
|
(= name "fn") (sf-lambda args env)
|
|
(= name "define") (sf-define args env)
|
|
(= name "defcomp") (sf-defcomp args env)
|
|
(= name "defmacro") (sf-defmacro args env)
|
|
(= name "defstyle") (sf-defstyle args env)
|
|
(= name "defkeyframes") (sf-defkeyframes 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 "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)
|
|
|
|
;; 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
|
|
(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 env)
|
|
(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)))
|
|
(apply f evaluated-args)
|
|
|
|
;; Lambda
|
|
(lambda? f)
|
|
(call-lambda f evaluated-args env)
|
|
|
|
;; Component
|
|
(component? f)
|
|
(call-component f args env)
|
|
|
|
:else (error (str "Not callable: " (inspect f)))))))
|
|
|
|
|
|
(define call-lambda
|
|
(fn (f args caller-env)
|
|
(let ((params (lambda-params f))
|
|
(local (env-merge (lambda-closure f) caller-env)))
|
|
(if (!= (len args) (len params))
|
|
(error (str (or (lambda-name f) "lambda")
|
|
" expects " (len params) " args, got " (len args)))
|
|
(do
|
|
;; Bind params
|
|
(for-each
|
|
(fn (pair) (env-set! local (first pair) (nth pair 1)))
|
|
(zip params args))
|
|
;; Return thunk for TCO
|
|
(make-thunk (lambda-body f) local))))))
|
|
|
|
|
|
(define call-component
|
|
(fn (comp raw-args env)
|
|
;; 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 env)
|
|
;; 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 env)
|
|
(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 env)
|
|
(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))))
|
|
|
|
|
|
(define sf-cond
|
|
(fn (args env)
|
|
;; Detect scheme-style: first arg is a 2-element list
|
|
(if (and (= (type-of (first args)) "list")
|
|
(= (len (first args)) 2))
|
|
;; Scheme-style: ((test body) ...)
|
|
(sf-cond-scheme args env)
|
|
;; Clojure-style: test body test body ...
|
|
(sf-cond-clojure args env))))
|
|
|
|
(define sf-cond-scheme
|
|
(fn (clauses env)
|
|
(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 env)
|
|
(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 env)
|
|
(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 env)
|
|
(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 env)
|
|
(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 env)
|
|
(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 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))))
|
|
|
|
|
|
(define sf-lambda
|
|
(fn (args env)
|
|
(let ((params-expr (first args))
|
|
(body (nth args 1))
|
|
(param-names (map (fn (p)
|
|
(if (= (type-of p) "symbol")
|
|
(symbol-name p)
|
|
p))
|
|
params-expr)))
|
|
(make-lambda param-names body env))))
|
|
|
|
|
|
(define sf-define
|
|
(fn (args env)
|
|
(let ((name-sym (first args))
|
|
(value (trampoline (eval-expr (nth args 1) 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)
|
|
value)))
|
|
|
|
|
|
(define sf-defcomp
|
|
(fn (args env)
|
|
(let ((name-sym (first args))
|
|
(params-raw (nth args 1))
|
|
(body (nth args 2))
|
|
(comp-name (strip-prefix (symbol-name name-sym) "~"))
|
|
(parsed (parse-comp-params params-raw))
|
|
(params (first parsed))
|
|
(has-children (nth parsed 1)))
|
|
(let ((comp (make-component comp-name params has-children body env)))
|
|
(env-set! env (symbol-name name-sym) comp)
|
|
comp))))
|
|
|
|
(define parse-comp-params
|
|
(fn (params-expr)
|
|
;; Parse (&key param1 param2 &children) → (params has-children)
|
|
;; Also accepts &rest as synonym for &children.
|
|
(let ((params (list))
|
|
(has-children false)
|
|
(in-key false))
|
|
(for-each
|
|
(fn (p)
|
|
(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))))
|
|
|
|
|
|
(define sf-defmacro
|
|
(fn (args env)
|
|
(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)
|
|
;; 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 env)
|
|
;; (defstyle name expr) — bind name to evaluated expr (typically a StyleValue)
|
|
(let ((name-sym (first args))
|
|
(value (trampoline (eval-expr (nth args 1) env))))
|
|
(env-set! env (symbol-name name-sym) value)
|
|
value)))
|
|
|
|
|
|
(define sf-defkeyframes
|
|
(fn (args env)
|
|
;; (defkeyframes name (selector body) ...) — build @keyframes rule,
|
|
;; register in keyframes dict, return StyleValue.
|
|
;; Delegates to platform: build-keyframes returns a StyleValue.
|
|
(let ((kf-name (symbol-name (first args)))
|
|
(steps (rest args)))
|
|
(build-keyframes kf-name steps env))))
|
|
|
|
|
|
(define sf-begin
|
|
(fn (args env)
|
|
(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 env)
|
|
(if (empty? args) nil (first args))))
|
|
|
|
|
|
(define sf-quasiquote
|
|
(fn (args env)
|
|
(qq-expand (first args) env)))
|
|
|
|
(define qq-expand
|
|
(fn (template env)
|
|
(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 (append result spliced))))
|
|
(append result (qq-expand item env))))
|
|
(list)
|
|
template)))))))
|
|
|
|
|
|
(define sf-thread-first
|
|
(fn (args env)
|
|
(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 env)
|
|
(let ((name (symbol-name (first args)))
|
|
(value (trampoline (eval-expr (nth args 1) env))))
|
|
(env-set! env name value)
|
|
value)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 6b. Macro expansion
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define expand-macro
|
|
(fn (mac raw-args env)
|
|
(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
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define ho-map
|
|
(fn (args env)
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map (fn (item) (trampoline (call-lambda f (list item) env))) coll))))
|
|
|
|
(define ho-map-indexed
|
|
(fn (args env)
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map-indexed
|
|
(fn (i item) (trampoline (call-lambda f (list i item) env)))
|
|
coll))))
|
|
|
|
(define ho-filter
|
|
(fn (args env)
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(filter
|
|
(fn (item) (trampoline (call-lambda f (list item) env)))
|
|
coll))))
|
|
|
|
(define ho-reduce
|
|
(fn (args env)
|
|
(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) (trampoline (call-lambda f (list acc item) env)))
|
|
init
|
|
coll))))
|
|
|
|
(define ho-some
|
|
(fn (args env)
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(some
|
|
(fn (item) (trampoline (call-lambda f (list item) env)))
|
|
coll))))
|
|
|
|
(define ho-every
|
|
(fn (args env)
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(every?
|
|
(fn (item) (trampoline (call-lambda f (list item) env)))
|
|
coll))))
|
|
|
|
|
|
(define ho-for-each
|
|
(fn (args env)
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(for-each
|
|
(fn (item) (trampoline (call-lambda 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"
|
|
;; (symbol-name sym) → string
|
|
;; (keyword-name kw) → string
|
|
;;
|
|
;; Constructors:
|
|
;; (make-lambda params body env) → Lambda
|
|
;; (make-component name params has-children body env) → 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
|
|
;; (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
|
|
;; (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
|
|
;;
|
|
;; CSSX (style system):
|
|
;; (build-keyframes name steps env) → StyleValue (platform builds @keyframes)
|
|
;; --------------------------------------------------------------------------
|