;; ==========================================================================
;; 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)))))


;; --------------------------------------------------------------------------
;; 2b. Strict mode — runtime type checking for primitive calls
;; --------------------------------------------------------------------------
;;
;; When *strict* is true, primitive calls check arg types before dispatch.
;; The primitive param type registry maps name → {positional [[name type]...],
;; rest-type type-or-nil}.  Stored in *prim-param-types* in the env.
;;
;; Strict mode is off by default. Hosts can enable it at startup via:
;;   (set-strict! true)
;;   (set-prim-param-types! types-dict)

(define *strict* false)

(define set-strict!
  (fn (val)
    (set! *strict* val)))

(define *prim-param-types* nil)

(define set-prim-param-types!
  (fn (types)
    (set! *prim-param-types* types)))

(define value-matches-type?
  (fn (val expected-type)
    ;; Check if a runtime value matches a declared type string.
    (cond
      (= expected-type "any")     true
      (= expected-type "number")  (number? val)
      (= expected-type "string")  (string? val)
      (= expected-type "boolean") (boolean? val)
      (= expected-type "nil")     (nil? val)
      (= expected-type "list")    (list? val)
      (= expected-type "dict")    (dict? val)
      (= expected-type "lambda")  (lambda? val)
      (= expected-type "symbol")  (= (type-of val) "symbol")
      (= expected-type "keyword") (= (type-of val) "keyword")
      ;; Nullable: "string?" means string or nil
      (and (string? expected-type)
           (ends-with? expected-type "?"))
        (or (nil? val)
            (value-matches-type? val (slice expected-type 0 (- (string-length expected-type) 1))))
      :else true)))

(define strict-check-args
  (fn (name args)
    ;; Check args against *prim-param-types* if strict mode is on.
    ;; Throws on type violation. No-op if *strict* is false or types not registered.
    (when (and *strict* *prim-param-types*)
      (let ((spec (get *prim-param-types* name)))
        (when spec
          (let ((positional (get spec "positional"))
                (rest-type  (get spec "rest-type")))
            ;; Check positional params
            (when positional
              (for-each
                (fn (pair)
                  (let ((idx      (first pair))
                        (param    (nth pair 1))
                        (p-name   (first param))
                        (p-type   (nth param 1)))
                    (when (< idx (len args))
                      (let ((val (nth args idx)))
                        (when (not (value-matches-type? val p-type))
                          (error (str "Type error: " name " expected " p-type
                                      " for param " p-name
                                      ", got " (type-of val) " (" (str val) ")")))))))
                (map-indexed (fn (i p) (list i p)) positional)))
            ;; Check rest args
            (when (and rest-type (> (len args) (len (or positional (list)))))
              (for-each
                (fn (pair)
                  (let ((idx (first pair))
                        (val (nth pair 1)))
                    (when (not (value-matches-type? val rest-type))
                      (error (str "Type error: " name " expected " rest-type
                                  " for rest arg " idx
                                  ", got " (type-of val) " (" (str val) ")")))))
                (map-indexed (fn (i v) (list i v))
                  (slice args (len (or positional (list)))))))))))))


;; --------------------------------------------------------------------------
;; 3. Core evaluator — stub (overridden by CEK in fixups)
;; --------------------------------------------------------------------------
;;
;; eval-expr and trampoline are defined as stubs here so the transpiler
;; creates the variable declarations. The CEK fixups override them with:
;;   eval-expr = (expr, env) → cek-run(make-cek-state(expr, env, []))
;;   trampoline = (val) → if thunk? then eval-expr(thunk-expr, thunk-env) else val
;; All evaluation goes through the CEK machine.

(define eval-expr
  (fn (expr (env :as dict))
    ;; Stub — overridden by CEK fixup before any code runs.
    ;; If this executes, CEK fixup failed to load.
    (error "eval-expr: CEK fixup not loaded")))


;; [REMOVED] Section 4: Tree-walk eval-list dispatch table — superseded by CEK step-eval-list


;; --------------------------------------------------------------------------
;; 5. Function / lambda / component call
;; --------------------------------------------------------------------------
;; [REMOVED] eval-call — superseded by CEK continue-with-call

(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-bind! local (first pair) (nth pair 1)))
            (zip params args))
          (for-each
            (fn (p) (env-bind! 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-bind! local p (or (dict-get kwargs p) nil)))
        (component-params comp))
      ;; Bind children if component accepts them
      (when (component-has-children? comp)
        (env-bind! 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
;; --------------------------------------------------------------------------
;; [REMOVED] sf-if, sf-when, sf-cond, sf-case, sf-and, sf-or, sf-let
;; — all superseded by CEK step handlers in cek.sx


;; cond-scheme? — still needed by CEK's step-sf-cond
(define cond-scheme?
  (fn ((clauses :as list))
    (every? (fn (c) (and (= (type-of c) "list") (= (len c) 2)))
            clauses)))


;; 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-bind! (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-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-bind! env "*effect-annotations*" effect-anns)))
        (env-bind! 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-bind! 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-bind! 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-bind! 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-bind! 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-bind! env "*effect-registry*" registry)
      nil)))


(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)))))))


;; --------------------------------------------------------------------------
;; 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-bind! 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-bind! 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-bind! 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-bind! (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-bind! 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-bind! local (macro-rest-param mac)
          (slice raw-args (len (macro-params mac)))))
      ;; Evaluate body → new AST
      (trampoline (eval-expr (macro-body mac) local)))))


;; [REMOVED] Section 7: Tree-walk HO forms — superseded by CEK step-ho-* in cek.sx

;; --------------------------------------------------------------------------
;; 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-bind! env name val) → void (create binding on THIS env, no chain walk)
;;   (env-set! env name val)  → void (mutate existing binding, walks scope chain)
;;   (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)
;; --------------------------------------------------------------------------