giles
ea2b71cfa3
Four new primitives for scoped downward value passing and upward accumulation through the render tree. Specced in .sx, bootstrapped to Python and JS across all adapters (eval, html, sx, dom, async). Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
1166 lines
46 KiB
Plaintext
1166 lines
46 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}
|
|
;; 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 "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))))
|
|
;; Call entry thunk
|
|
(call-thunk before env)
|
|
;; Push wind record, run body, pop, call exit
|
|
(push-wind! before after)
|
|
(let ((result (call-thunk body env)))
|
|
(pop-wind!)
|
|
(call-thunk after env)
|
|
result))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 6a2. provide — render-time dynamic scope
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; (provide name value body...) — push a named scope with value and empty
|
|
;; accumulator, evaluate body, pop scope. Returns last body result.
|
|
|
|
(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))
|
|
(provide-push! name val)
|
|
(for-each (fn (e) (set! result (trampoline (eval-expr e env)))) body-exprs)
|
|
(provide-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)
|
|
;; --------------------------------------------------------------------------
|