Step 11: define-foreign FFI + transpiler mutable globals fix

FFI: define-foreign special form in evaluator — registry, param parser,
kwargs parser, binding resolver, type checker, lambda builder, dispatcher.
Generates callable lambdas that route through foreign-dispatch to host-call.
24 tests in test-foreign.sx (registry, parsing, resolution, type checking).

Transpiler: fix mutable global ref emission — ml-emit-define now emits
both X_ref = ref <init> and X_ = <init> for starred globals (was missing
the ref definition entirely, broke retranspilation). Add *provide-batch-depth*,
*provide-batch-queue*, *provide-subscribers* to mutable globals list.

Evaluator: add missing (define *provide-batch-queue* (list)) and
(define *provide-subscribers* (dict)) — were only in hand-edited sx_ref.ml.

Known: 36 bind-tracking + 8 capability test failures on retranspilation
(pre-existing transpiler local-ref shadowing bug, not caused by FFI).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

hosts/ocaml/transpiler.sx

@@ -285,7 +285,14 @@
 
 (define
   ml-mutable-globals
-  (list "*strict*" "*prim-param-types*" "*last-error-kont*" "*bind-tracking*"))
+  (list
+    "*strict*"
+    "*prim-param-types*"
+    "*last-error-kont*"
+    "*bind-tracking*"
+    "*provide-batch-depth*"
+    "*provide-batch-queue*"
+    "*provide-subscribers*"))
 
 (define
   ml-is-mutable-global?
@@ -1824,7 +1831,16 @@
                       "\n")))))
             (if
               (ml-is-mutable-global? name)
-              (str "let " ml-name " =\n  !" ml-name "ref\n")
+              (str
+                "let "
+                ml-name
+                "ref = ref "
+                (ml-expr val-expr)
+                "\nand "
+                ml-name
+                " =\n  "
+                (ml-expr val-expr)
+                "\n")
               (str "let " ml-name " =\n  " (ml-expr val-expr) "\n"))))))))
 
 (define
@@ -1935,5 +1951,14 @@
                     "\n")))))
           (if
             (ml-is-mutable-global? name)
-            (str "let rec " ml-name " =\n  !" ml-name "ref\n")
+            (str
+              "let rec "
+              ml-name
+              "ref = ref "
+              (ml-expr val-expr)
+              "\nand "
+              ml-name
+              " =\n  "
+              (ml-expr val-expr)
+              "\n")
             (str "let rec " ml-name " =\n  " (ml-expr val-expr) "\n")))))))

spec/evaluator.sx

@@ -49,6 +49,8 @@
 
 (define make-define-frame (fn (name env has-effects effect-list) {:env env :effect-list effect-list :has-effects has-effects :type "define" :name name}))
 
+(define make-define-foreign-frame (fn (name spec env) {:spec spec :env env :type "define-foreign" :name name}))
+
 (define make-set-frame (fn (name env) {:env env :type "set" :name name}))
 
 (define
@@ -59,9 +61,9 @@
 
 (define make-cond-frame (fn (remaining env scheme?) {:scheme scheme? :env env :type "cond" :remaining remaining}))
 
+;; Higher-order iteration frames
 (define make-cond-arrow-frame (fn (test-value env) {:env env :match-val test-value :type "cond-arrow"}))
 
-;; Higher-order iteration frames
 (define make-case-frame (fn (match-val remaining env) {:match-val match-val :env env :type "case" :remaining remaining}))
 
 (define make-thread-frame (fn (remaining env mode name) {:env env :type "thread" :extra mode :remaining remaining :name name}))
@@ -92,69 +94,69 @@
 
 (define make-multi-map-frame (fn (f remaining-lists results env) {:env env :results results :type "multi-map" :f f :remaining remaining-lists}))
 
+;; Scope/provide/context — downward data passing without env threading
 (define
   make-filter-frame
   (fn (f remaining results current-item env) {:current-item current-item :env env :results results :type "filter" :f f :remaining remaining}))
 
-;; Scope/provide/context — downward data passing without env threading
 (define make-reduce-frame (fn (f remaining env) {:env env :type "reduce" :f f :remaining remaining}))
 
 (define make-for-each-frame (fn (f remaining env) {:env env :type "for-each" :f f :remaining remaining}))
 
+;; Delimited continuations (shift/reset)
 (define make-some-frame (fn (f remaining env) {:env env :type "some" :f f :remaining remaining}))
 
-;; Delimited continuations (shift/reset)
 (define make-every-frame (fn (f remaining env) {:env env :type "every" :f f :remaining remaining}))
 
 (define make-scope-frame (fn (name remaining env) {:env env :type "scope" :remaining remaining :name name}))
 
 (define make-provide-frame (fn (name value remaining env) {:subscribers (list) :env env :value value :type "provide" :remaining remaining :name name}))
 
+;; Dynamic wind + reactive signals
 (define make-bind-frame (fn (body env prev-tracking) {:body body :env env :type "bind" :prev-tracking prev-tracking}))
 
-;; Dynamic wind + reactive signals
 (define make-provide-set-frame (fn (name env) {:env env :type "provide-set" :name name}))
 
+;; Undelimited continuations (call/cc)
 (define make-scope-acc-frame (fn (name value remaining env) {:env env :value (or value nil) :type "scope-acc" :remaining remaining :emitted (list) :name name}))
 
-;; Undelimited continuations (call/cc)
 (define make-reset-frame (fn (env) {:env env :type "reset"}))
 
-(define make-dict-frame (fn (remaining results env) {:env env :results results :type "dict" :remaining remaining}))
-
 ;; HO setup: staged argument evaluation for map/filter/etc.
 ;; Evaluates args one at a time, then dispatches to the correct
 ;; HO frame (map, filter, reduce) once all args are ready.
+(define make-dict-frame (fn (remaining results env) {:env env :results results :type "dict" :remaining remaining}))
+
 (define make-and-frame (fn (remaining env) {:env env :type "and" :remaining remaining}))
 
 (define make-or-frame (fn (remaining env) {:env env :type "or" :remaining remaining}))
 
+;; Condition system frames (handler-bind, restart-case, signal)
 (define
   make-dynamic-wind-frame
   (fn (phase body-thunk after-thunk env) {:env env :phase phase :after-thunk after-thunk :type "dynamic-wind" :body-thunk body-thunk}))
 
-;; Condition system frames (handler-bind, restart-case, signal)
 (define
   make-reactive-reset-frame
   (fn (env update-fn first-render?) {:first-render first-render? :update-fn update-fn :env env :type "reactive-reset"}))
 
 (define make-callcc-frame (fn (env) {:env env :type "callcc"}))
 
+;; R7RS exception frames (raise, guard)
 (define make-deref-frame (fn (env) {:env env :type "deref"}))
 
-;; R7RS exception frames (raise, guard)
 (define
   make-ho-setup-frame
   (fn (ho-type remaining-args evaled-args env) {:ho-type ho-type :env env :evaled evaled-args :type "ho-setup" :remaining remaining-args}))
 
-(define make-comp-trace-frame (fn (name file) {:env file :type "comp-trace" :name name}))
-
 ;; ═══════════════════════════════════════════════════════════════
 ;; Part 3: Continuation Stack Operations
 ;;
 ;; Searching and manipulating the kont list — finding handlers,
 ;; restarts, scope accumulators, and capturing delimited slices.
 ;; ═══════════════════════════════════════════════════════════════
+(define make-comp-trace-frame (fn (name file) {:env file :type "comp-trace" :name name}))
+
 (define
   kont-collect-comp-trace
   (fn
@@ -173,9 +175,9 @@
 
 (define make-restart-frame (fn (restarts remaining env) {:env env :type "restart" :f restarts :remaining remaining}))
 
+;; Basic kont operations
 (define make-signal-return-frame (fn (env saved-kont) {:env env :type "signal-return" :f saved-kont}))
 
-;; Basic kont operations
 (define make-raise-eval-frame (fn (env continuable?) {:scheme continuable? :env env :type "raise-eval"}))
 
 (define make-raise-guard-frame (fn (env saved-kont) {:env env :type "raise-guard" :remaining saved-kont}))
@@ -184,9 +186,9 @@
 
 (define make-vm-resume-frame (fn (resume-fn env) {:env env :type "vm-resume" :f resume-fn}))
 
+;; Capture frames up to a reset boundary — used by shift
 (define make-import-frame (fn (import-set remaining-sets env) {:args import-set :env env :type "import" :remaining remaining-sets}))
 
-;; Capture frames up to a reset boundary — used by shift
 (define
   make-parameterize-frame
   (fn (remaining current-param results body env) {:env env :body body :results results :type "parameterize" :f current-param :remaining remaining}))
@@ -240,6 +242,12 @@
           entry
           (find-named-restart (rest restarts) name))))))
 
+;; ═══════════════════════════════════════════════════════════════
+;; Part 4: Extension Points & Mutable State
+;;
+;; Custom special forms registry, render hooks, strict mode.
+;; Mutable globals use set! — the transpiler emits OCaml refs.
+;; ═══════════════════════════════════════════════════════════════
 (define
   kont-find-restart
   (fn
@@ -259,12 +267,6 @@
               (list match frame (rest kont))))
           (kont-find-restart (rest kont) name))))))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 4: Extension Points & Mutable State
-;;
-;; Custom special forms registry, render hooks, strict mode.
-;; Mutable globals use set! — the transpiler emits OCaml refs.
-;; ═══════════════════════════════════════════════════════════════
 (define frame-type (fn (f) (get f "type")))
 
 (define kont-push (fn (frame kont) (cons frame kont)))
@@ -356,6 +358,14 @@
         true
         (has-reactive-reset-frame? (rest kont))))))
 
+;; ═══════════════════════════════════════════════════════════════
+;; Part 5: Evaluation Utilities
+;;
+;; Forward-declared eval-expr, lambda/component calling, keyword
+;; arg parsing, special form constructors (lambda, defcomp,
+;; defmacro, quasiquote), and macro expansion.
+;; ═══════════════════════════════════════════════════════════════
+;; Forward declaration — redefined at end of file as CEK entry point
 (define
   kont-capture-to-reactive-reset
   (fn
@@ -375,37 +385,33 @@
               (scan (rest k) (append captured (list frame))))))))
     (scan kont (list))))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 5: Evaluation Utilities
-;;
-;; Forward-declared eval-expr, lambda/component calling, keyword
-;; arg parsing, special form constructors (lambda, defcomp,
-;; defmacro, quasiquote), and macro expansion.
-;; ═══════════════════════════════════════════════════════════════
-;; Forward declaration — redefined at end of file as CEK entry point
-(define *custom-special-forms* (dict))
-
 ;; Shared param binding for lambda/component calls.
 ;; Handles &rest collection — used by both call-lambda and continue-with-call.
+(define *custom-special-forms* (dict))
+
 (define
   register-special-form!
   (fn
     ((name :as string) handler)
     (dict-set! *custom-special-forms* name handler)))
 
+;; Component calls: parse keyword args, bind params, TCO thunk
 (define *render-check* nil)
 
-;; Component calls: parse keyword args, bind params, TCO thunk
 (define *render-fn* nil)
 
+;; Cond/case helpers
 (define *bind-tracking* nil)
 
-;; Cond/case helpers
 (define *provide-batch-depth* 0)
 
+;; Special form constructors — build state for CEK evaluation
+(define *provide-batch-queue* (list))
+
+(define *provide-subscribers* (dict))
+
 (define *library-registry* (dict))
 
-;; Special form constructors — build state for CEK evaluation
 (define
   library-name-key
   (fn
@@ -432,15 +438,249 @@
 
 (define *io-registry* (dict))
 
+;; Quasiquote expansion
 (define io-register! (fn (name spec) (dict-set! *io-registry* name spec)))
 
 (define io-registered? (fn (name) (has-key? *io-registry* name)))
 
 (define io-lookup (fn (name) (get *io-registry* name)))
 
-;; Quasiquote expansion
 (define io-names (fn () (keys *io-registry*)))
 
+(define *foreign-registry* (dict))
+
+(define
+  foreign-register!
+  (fn (name spec) (dict-set! *foreign-registry* name spec)))
+
+;; Macro expansion — expand then re-evaluate the result
+(define foreign-registered? (fn (name) (has-key? *foreign-registry* name)))
+
+;; ═══════════════════════════════════════════════════════════════
+;; Part 6: CEK Machine Core
+;;
+;; cek-run: trampoline loop — steps until terminal.
+;; cek-step: single step — dispatches on phase (eval vs continue).
+;; step-eval: evaluates control expression, pushes frames.
+;; step-continue: pops a frame, processes result.
+;; ═══════════════════════════════════════════════════════════════
+(define foreign-lookup (fn (name) (get *foreign-registry* name)))
+
+(define foreign-names (fn () (keys *foreign-registry*)))
+
+(define
+  foreign-parse-params
+  (fn
+    (param-list)
+    (let
+      ((result (list))
+        (i 0)
+        (items (if (list? param-list) param-list (list))))
+      (foreign-parse-params-loop items result))))
+
+;; ═══════════════════════════════════════════════════════════════
+;; Part 7: Special Form Step Functions
+;;
+;; Each step-sf-* handles one special form in the eval phase.
+;; They push frames and return new CEK states — never recurse.
+;; ═══════════════════════════════════════════════════════════════
+(define
+  foreign-parse-kwargs!
+  (fn
+    (spec remaining)
+    (when
+      (and
+        (not (empty? remaining))
+        (>= (len remaining) 2)
+        (keyword? (first remaining)))
+      (dict-set!
+        spec
+        (keyword-name (first remaining))
+        (let
+          ((v (nth remaining 1)))
+          (if (keyword? v) (keyword-name v) v)))
+      (foreign-parse-kwargs! spec (rest (rest remaining))))))
+
+;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise
+(define
+  foreign-resolve-binding
+  (fn
+    (binding-str)
+    (let
+      ((parts (split binding-str ".")))
+      (if
+        (<= (len parts) 1)
+        {:method binding-str :object nil}
+        (let
+          ((method (last parts))
+            (obj (join "." (reverse (rest (reverse parts))))))
+          {:method method :object obj})))))
+
+;; List evaluation — dispatches on head: special forms, macros,
+;; higher-order forms, or function calls. This is the main
+;; expression dispatcher for the CEK machine.
+(define
+  foreign-check-args
+  (fn
+    (name params args)
+    (when
+      (and (not (empty? params)) (< (len args) (len params)))
+      (error
+        (str
+          "foreign "
+          name
+          ": expected "
+          (len params)
+          " args, got "
+          (len args))))
+    (for-each
+      (fn
+        (i)
+        (let
+          ((spec (nth params i))
+            (val (nth args i))
+            (expected (get spec "type")))
+          (when
+            (and
+              (not (= expected "any"))
+              (not (value-matches-type? val expected)))
+            (error
+              (str
+                "foreign "
+                name
+                ": arg '"
+                (get spec "name")
+                "' expected "
+                expected
+                ", got "
+                (type-of val))))))
+      (range 0 (min (len params) (len args))))))
+
+;; call/cc: capture entire kont as undelimited escape continuation
+(define
+  foreign-build-lambda
+  (fn
+    (spec)
+    (let
+      ((name (get spec "name"))
+        (mode
+          (if
+            (has-key? spec "returns")
+            (let
+              ((r (get spec "returns")))
+              (if (= r "promise") "async" "sync"))
+            "sync")))
+      (if
+        (= mode "async")
+        (list
+          (quote fn)
+          (list (quote &rest) (quote __ffi-args__))
+          (list
+            (quote perform)
+            (list
+              (quote foreign-dispatch)
+              (list (quote quote) name)
+              (quote __ffi-args__))))
+        (list
+          (quote fn)
+          (list (quote &rest) (quote __ffi-args__))
+          (list
+            (quote foreign-dispatch)
+            (list (quote quote) name)
+            (quote __ffi-args__)))))))
+
+(define
+  sf-define-foreign
+  (fn
+    (args env)
+    (let
+      ((name (if (symbol? (first args)) (symbol-name (first args)) (first args)))
+        (param-list (nth args 1))
+        (spec (dict)))
+      (dict-set! spec "name" name)
+      (dict-set! spec "params" (foreign-parse-params param-list))
+      (foreign-parse-kwargs! spec (rest (rest args)))
+      (foreign-register! name spec)
+      spec)))
+
+(define
+  step-sf-define-foreign
+  (fn
+    (args env kont)
+    (let
+      ((spec (sf-define-foreign args env))
+        (name
+          (if
+            (symbol? (first args))
+            (symbol-name (first args))
+            (first args)))
+        (lambda-expr (foreign-build-lambda spec)))
+      (make-cek-state
+        lambda-expr
+        env
+        (kont-push (make-define-foreign-frame name spec env) kont)))))
+
+;; Pattern matching (match form)
+(define
+  foreign-dispatch
+  (fn
+    (name args)
+    (let
+      ((spec (foreign-lookup name)))
+      (when
+        (nil? spec)
+        (error (str "foreign-dispatch: unknown foreign function '" name "'")))
+      (let
+        ((params (get spec "params")) (binding (get spec "js")))
+        (foreign-check-args name (if (nil? params) (list) params) args)
+        (if
+          (nil? binding)
+          (error (str "foreign " name ": no binding for current platform"))
+          (let
+            ((resolved (foreign-resolve-binding binding))
+              (obj-name (get resolved "object"))
+              (method (get resolved "method")))
+            (if
+              (primitive? "host-call")
+              (if
+                (nil? obj-name)
+                (apply
+                  (get-primitive "host-call")
+                  (concat (list nil method) args))
+                (let
+                  ((obj ((get-primitive "host-global") obj-name)))
+                  (apply
+                    (get-primitive "host-call")
+                    (concat (list obj method) args))))
+              (error
+                (str
+                  "foreign "
+                  name
+                  ": host-call not available on this platform")))))))))
+
+;; Condition system special forms
+(define
+  foreign-parse-params-loop
+  (fn
+    (items acc)
+    (if
+      (empty? items)
+      acc
+      (let
+        ((item (first items)) (rest-items (rest items)))
+        (if
+          (and
+            (not (empty? rest-items))
+            (keyword? (first rest-items))
+            (= (keyword-name (first rest-items)) "as")
+            (>= (len rest-items) 2))
+          (foreign-parse-params-loop
+            (rest (rest rest-items))
+            (append acc (list {:type (let ((t (nth rest-items 1))) (if (keyword? t) (keyword-name t) (str t))) :name (if (symbol? item) (symbol-name item) (str item))})))
+          (foreign-parse-params-loop
+            rest-items
+            (append acc (list {:type "any" :name (if (symbol? item) (symbol-name item) (str item))}))))))))
+
 (define
   step-sf-io
   (fn
@@ -471,17 +711,8 @@
 
 (define *prim-param-types* nil)
 
-;; Macro expansion — expand then re-evaluate the result
 (define set-prim-param-types! (fn (types) (set! *prim-param-types* types)))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 6: CEK Machine Core
-;;
-;; cek-run: trampoline loop — steps until terminal.
-;; cek-step: single step — dispatches on phase (eval vs continue).
-;; step-eval: evaluates control expression, pushes frames.
-;; step-continue: pops a frame, processes result.
-;; ═══════════════════════════════════════════════════════════════
 (define
   value-matches-type?
   (fn
@@ -579,12 +810,6 @@
 
 (define eval-expr (fn (expr (env :as dict)) nil))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 7: Special Form Step Functions
-;;
-;; Each step-sf-* handles one special form in the eval phase.
-;; They push frames and return new CEK states — never recurse.
-;; ═══════════════════════════════════════════════════════════════
 (define
   bind-lambda-params
   (fn
@@ -609,7 +834,6 @@
             true))
         false))))
 
-;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise
 (define
   call-lambda
   (fn
@@ -636,9 +860,6 @@
           (slice params (len args))))
       (make-thunk (lambda-body f) local))))
 
-;; List evaluation — dispatches on head: special forms, macros,
-;; higher-order forms, or function calls. This is the main
-;; expression dispatcher for the CEK machine.
 (define
   call-component
   (fn
@@ -656,7 +877,6 @@
         (env-bind! local "children" children))
       (make-thunk (component-body comp) local))))
 
-;; call/cc: capture entire kont as undelimited escape continuation
 (define
   parse-keyword-args
   (fn
@@ -715,7 +935,7 @@
         (= (type-of test) "symbol")
         (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))))))
 
-;; Pattern matching (match form)
+;; Scope/provide/context — structured downward data passing
 (define
   sf-named-let
   (fn
@@ -763,7 +983,6 @@
           ((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits)))
           (cek-call loop-fn init-vals))))))
 
-;; Condition system special forms
 (define
   sf-lambda
   (fn
@@ -852,6 +1071,18 @@
         (range 2 end 1))
       result)))
 
+;; ═══════════════════════════════════════════════════════════════
+;; R7RS syntax-rules / define-syntax
+;;
+;; syntax-rules creates a macro transformer via pattern matching.
+;; define-syntax binds the transformer as a macro (reuses define).
+;; Pattern language: _ (wildcard), literals (exact match),
+;; pattern variables (bind), ... (ellipsis/repetition).
+;; ═══════════════════════════════════════════════════════════════
+
+;; Match a syntax-rules pattern against a form.
+;; Returns a dict of bindings on success, nil on failure.
+;; literals is a list of symbol name strings that must match exactly.
 (define
   parse-comp-params
   (fn
@@ -898,6 +1129,8 @@
         params-expr)
       (list params has-children param-types))))
 
+;; Match a list pattern against a form list, handling ellipsis at any position.
+;; pi = pattern index, fi = form index.
 (define
   sf-defisland
   (fn
@@ -923,6 +1156,8 @@
         (env-bind! env (symbol-name name-sym) island)
         island))))
 
+;; Find which pattern variable in a template drives an ellipsis.
+;; Returns the variable name (string) whose binding is a list, or nil.
 (define
   defio-parse-kwargs!
   (fn
@@ -935,6 +1170,8 @@
       (dict-set! spec (keyword-name (first remaining)) (nth remaining 1))
       (defio-parse-kwargs! spec (rest (rest remaining))))))
 
+;; Find ALL ellipsis-bound pattern variables in a template.
+;; Returns a list of variable name strings.
 (define
   sf-defio
   (fn
@@ -946,6 +1183,8 @@
       (io-register! name spec)
       spec)))
 
+;; Instantiate a template with pattern variable bindings.
+;; Handles ellipsis repetition and recursive substitution.
 (define
   sf-defmacro
   (fn
@@ -962,6 +1201,9 @@
         (env-bind! env (symbol-name name-sym) mac)
         mac))))
 
+;; Walk a template list, handling ellipsis at any position.
+;; When element at i is followed by ... at i+1, expand the element
+;; for each value of its ellipsis variables (all cycled in parallel).
 (define
   parse-macro-params
   (fn
@@ -990,6 +1232,10 @@
         params-expr)
       (list params rest-param))))
 
+;; Try each syntax-rules clause against a form.
+;; Returns the instantiated template for the first matching rule, or errors.
+;; form is the raw args (without macro name). We prepend a dummy _ symbol
+;; because syntax-rules patterns include the keyword as the first element.
 (define
   qq-expand
   (fn
@@ -1084,6 +1330,10 @@
         (slice body 0 (dec (len body))))
       (make-thunk (last body) local))))
 
+;; Special form: (syntax-rules (literal ...) (pattern template) ...)
+;; Creates a Macro with rules/literals stored in closure env.
+;; Body is a marker symbol; expand-macro detects it and calls
+;; the pattern matcher directly.
 (define
   step-sf-letrec
   (fn
@@ -1102,6 +1352,17 @@
         (after (trampoline (eval-expr (nth args 2) env))))
       (dynamic-wind-call before body after env))))
 
+;; R7RS records (SRFI-9)
+;;
+;; (define-record-type <point>
+;;   (make-point x y)
+;;   point?
+;;   (x point-x)
+;;   (y point-y set-point-y!))
+;;
+;; Creates: constructor, predicate, accessors, optional mutators.
+;; Opaque — only accessible through generated functions.
+;; Generative — each call creates a unique type.
 (define
   sf-scope
   (fn
@@ -1129,6 +1390,7 @@
         (scope-pop! name)
         result))))
 
+;; Delimited continuations
 (define
   sf-provide
   (fn
@@ -1180,7 +1442,7 @@
               (slice raw-args (len (macro-params mac)))))
           (trampoline (eval-expr (macro-body mac) local)))))))
 
-;; Scope/provide/context — structured downward data passing
+;; Signal dereferencing with reactive dependency tracking
 (define
   cek-step-loop
   (fn
@@ -1190,6 +1452,13 @@
       state
       (cek-step-loop (cek-step state)))))
 
+;; ═══════════════════════════════════════════════════════════════
+;; Part 8: Call Dispatch
+;;
+;; cek-call: invoke a function from native code (runs a nested
+;; trampoline). step-eval-call: CEK-native call dispatch for
+;; lambda, component, native fn, and continuations.
+;; ═══════════════════════════════════════════════════════════════
 (define
   cek-run
   (fn
@@ -1201,6 +1470,7 @@
         (error "IO suspension in non-IO context")
         (cek-value final)))))
 
+;; Reactive signal tracking — captures dependency continuation for re-render
 (define
   cek-resume
   (fn
@@ -1221,17 +1491,12 @@
       (step-continue state))))
 
 ;; ═══════════════════════════════════════════════════════════════
-;; R7RS syntax-rules / define-syntax
+;; Part 9: Higher-Order Form Machinery
 ;;
-;; syntax-rules creates a macro transformer via pattern matching.
+;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
-;; define-syntax binds the transformer as a macro (reuses define).
+;; ho-swap-args auto-detects argument order. HoSetupFrame stages
-;; Pattern language: _ (wildcard), literals (exact match),
+;; argument evaluation, then dispatches to the appropriate step-ho-*.
-;; pattern variables (bind), ... (ellipsis/repetition).
 ;; ═══════════════════════════════════════════════════════════════
-
-;; Match a syntax-rules pattern against a form.
-;; Returns a dict of bindings on success, nil on failure.
-;; literals is a list of symbol name strings that must match exactly.
 (define
   step-eval
   (fn
@@ -1288,8 +1553,6 @@
           (step-eval-list expr env kont))
         :else (make-cek-value expr env kont)))))
 
-;; Match a list pattern against a form list, handling ellipsis at any position.
-;; pi = pattern index, fi = form index.
 (define
   step-sf-raise
   (fn
@@ -1299,8 +1562,6 @@
       env
       (kont-push (make-raise-eval-frame env false) kont))))
 
-;; Find which pattern variable in a template drives an ellipsis.
-;; Returns the variable name (string) whose binding is a list, or nil.
 (define
   step-sf-guard
   (fn
@@ -1374,8 +1635,6 @@
         env
         kont))))
 
-;; Find ALL ellipsis-bound pattern variables in a template.
-;; Returns a list of variable name strings.
 (define
   step-sf-callcc
   (fn
@@ -1385,8 +1644,6 @@
       env
       (kont-push (make-callcc-frame env) kont))))
 
-;; Instantiate a template with pattern variable bindings.
-;; Handles ellipsis repetition and recursive substitution.
 (define
   step-sf-case
   (fn
@@ -1396,9 +1653,6 @@
       env
       (kont-push (make-case-frame nil (rest args) env) kont))))
 
-;; Walk a template list, handling ellipsis at any position.
-;; When element at i is followed by ... at i+1, expand the element
-;; for each value of its ellipsis variables (all cycled in parallel).
 (define
   step-sf-let-match
   (fn
@@ -1412,10 +1666,6 @@
         env
         kont))))
 
-;; Try each syntax-rules clause against a form.
-;; Returns the instantiated template for the first matching rule, or errors.
-;; form is the raw args (without macro name). We prepend a dummy _ symbol
-;; because syntax-rules patterns include the keyword as the first element.
 (define
   step-eval-list
   (fn
@@ -1456,6 +1706,7 @@
               ("defisland" (make-cek-value (sf-defisland args env) env kont))
               ("defmacro" (make-cek-value (sf-defmacro args env) env kont))
               ("defio" (make-cek-value (sf-defio args env) env kont))
+              ("define-foreign" (step-sf-define-foreign args env kont))
               ("io" (step-sf-io args env kont))
               ("begin" (step-sf-begin args env kont))
               ("do"
@@ -1598,10 +1849,6 @@
           (cons {:subscribers (list) :env (get frame "env") :value (get frame "value") :type "provide" :remaining (list) :name (get frame "name")} rest-frames)
           rest-frames)))))
 
-;; Special form: (syntax-rules (literal ...) (pattern template) ...)
-;; Creates a Macro with rules/literals stored in closure env.
-;; Body is a marker symbol; expand-macro detects it and calls
-;; the pattern matcher directly.
 (define
   fire-provide-subscribers
   (fn
@@ -1640,22 +1887,18 @@
             subs)
           (for-each (fn (sub) (cek-call sub (list nil))) subs))))))
 
-;; R7RS records (SRFI-9)
-;;
-;; (define-record-type <point>
-;;   (make-point x y)
-;;   point?
-;;   (x point-x)
-;;   (y point-y set-point-y!))
-;;
-;; Creates: constructor, predicate, accessors, optional mutators.
-;; Opaque — only accessible through generated functions.
-;; Generative — each call creates a unique type.
 (define
   batch-begin!
   (fn () (set! *provide-batch-depth* (+ *provide-batch-depth* 1))))
 
-;; Delimited continuations
+;; ═══════════════════════════════════════════════════════════════
+;; Part 10: Continue Phase — Frame Dispatch
+;;
+;; When phase="continue", pop the top frame and process the value.
+;; Each frame type has its own handling: if frames check truthiness,
+;; let frames bind the value, arg frames accumulate it, etc.
+;; continue-with-call handles the final function/component dispatch.
+;; ═══════════════════════════════════════════════════════════════
 (define
   batch-end!
   (fn
@@ -1668,6 +1911,9 @@
         (set! *provide-batch-queue* (list))
         (for-each (fn (sub) (cek-call sub (list nil))) queue)))))
 
+;; Final call dispatch from arg frame — all args evaluated, invoke function.
+;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
+;; native fn (direct call), continuation (resume), callcc continuation (escape).
 (define
   step-sf-bind
   (fn
@@ -1680,7 +1926,6 @@
         env
         (kont-push (make-bind-frame body env prev) kont)))))
 
-;; Signal dereferencing with reactive dependency tracking
 (define
   step-sf-parameterize
   (fn
@@ -1700,11 +1945,11 @@
               kont)))))))
 
 ;; ═══════════════════════════════════════════════════════════════
-;; Part 8: Call Dispatch
+;; Part 11: Entry Points
 ;;
-;; cek-call: invoke a function from native code (runs a nested
+;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
-;; trampoline). step-eval-call: CEK-native call dispatch for
+;; eval-expr / trampoline: top-level bindings that override the
-;; lambda, component, native fn, and continuations.
+;; forward declarations from Part 5.
 ;; ═══════════════════════════════════════════════════════════════
 (define
   syntax-rules-match
@@ -1726,7 +1971,6 @@
       (syntax-rules-match-list pattern 0 form 0 literals)
       :else (if (= pattern form) (dict) nil))))
 
-;; Reactive signal tracking — captures dependency continuation for re-render
 (define
   syntax-rules-match-list
   (fn
@@ -1828,13 +2072,6 @@
         template)
       :else nil)))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 9: Higher-Order Form Machinery
-;;
-;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
-;; ho-swap-args auto-detects argument order. HoSetupFrame stages
-;; argument evaluation, then dispatches to the appropriate step-ho-*.
-;; ═══════════════════════════════════════════════════════════════
 (define
   syntax-rules-find-all-vars
   (fn
@@ -2076,14 +2313,6 @@
 
 (define *protocol-registry* (dict))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 10: Continue Phase — Frame Dispatch
-;;
-;; When phase="continue", pop the top frame and process the value.
-;; Each frame type has its own handling: if frames check truthiness,
-;; let frames bind the value, arg frames accumulate it, etc.
-;; continue-with-call handles the final function/component dispatch.
-;; ═══════════════════════════════════════════════════════════════
 (define
   sf-define-record-type
   (fn
@@ -2120,9 +2349,6 @@
               field-specs)
             nil))))))
 
-;; Final call dispatch from arg frame — all args evaluated, invoke function.
-;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
-;; native fn (direct call), continuation (resume), callcc continuation (escape).
 (define
   sf-define-protocol
   (fn
@@ -2239,13 +2465,6 @@
             (list "match checks nil but has no non-nil pattern"))))
       warnings)))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 11: Entry Points
-;;
-;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
-;; eval-expr / trampoline: top-level bindings that override the
-;; forward declarations from Part 5.
-;; ═══════════════════════════════════════════════════════════════
 (define
   sf-implement
   (fn
@@ -3293,6 +3512,14 @@
                     (dict-set! effect-anns name effect-names)
                     (env-bind! fenv "*effect-annotations*" effect-anns)))
                 (make-cek-value value fenv rest-k)))
+            ("define-foreign"
+              (let
+                ((name (get frame "name")) (fenv (get frame "env")))
+                (when
+                  (and (lambda? value) (nil? (lambda-name value)))
+                  (set-lambda-name! value name))
+                (env-bind! fenv name value)
+                (make-cek-value value fenv rest-k)))
             ("set"
               (let
                 ((name (get frame "name")) (fenv (get frame "env")))

spec/tests/test-foreign.sx

@@ -0,0 +1,179 @@
+;; FFI tests — define-foreign, *foreign-registry*, foreign-dispatch
+
+(defsuite
+  "foreign-registry-basic"
+  (deftest
+    "define-foreign registers in *foreign-registry*"
+    (define-foreign my-abs (x :as number) :returns :number :js "Math.abs")
+    (assert (foreign-registered? "my-abs")))
+  (deftest
+    "foreign-lookup returns spec dict"
+    (define-foreign my-floor (x :as number) :returns :number :js "Math.floor")
+    (let
+      ((spec (foreign-lookup "my-floor")))
+      (assert= (get spec "name") "my-floor")
+      (assert= (get spec "js") "Math.floor")
+      (assert= (get spec "returns") "number")))
+  (deftest
+    "foreign-names includes registered names"
+    (define-foreign my-ceil (x :as number) :returns :number :js "Math.ceil")
+    (assert (contains? (foreign-names) "my-ceil")))
+  (deftest
+    "define-foreign creates callable lambda"
+    (define-foreign my-round (x :as number) :returns :number :js "Math.round")
+    (assert (lambda? my-round)))
+  (deftest
+    "multiple define-foreign coexist"
+    (define-foreign ff-a () :js "Date.now")
+    (define-foreign ff-b (s :as string) :js "parseInt")
+    (assert (foreign-registered? "ff-a"))
+    (assert (foreign-registered? "ff-b"))))
+
+(defsuite
+  "foreign-param-parsing"
+  (deftest
+    "single param with type"
+    (define-foreign fp-one (url :as string) :js "encodeURI")
+    (let
+      ((spec (foreign-lookup "fp-one")))
+      (let
+        ((params (get spec "params")))
+        (assert= (len params) 1)
+        (assert= (get (first params) "name") "url")
+        (assert= (get (first params) "type") "string"))))
+  (deftest
+    "multiple params with types"
+    (define-foreign fp-two (base :as string radix :as number) :js "parseInt")
+    (let
+      ((spec (foreign-lookup "fp-two")))
+      (let
+        ((params (get spec "params")))
+        (assert= (len params) 2)
+        (assert= (get (first params) "name") "base")
+        (assert= (get (first params) "type") "string")
+        (assert= (get (nth params 1) "name") "radix")
+        (assert= (get (nth params 1) "type") "number"))))
+  (deftest
+    "no params"
+    (define-foreign fp-none () :js "Date.now")
+    (let
+      ((spec (foreign-lookup "fp-none")))
+      (assert= (len (get spec "params")) 0)))
+  (deftest
+    "param without :as defaults to any"
+    (define-foreign fp-any (x) :js "String")
+    (let
+      ((spec (foreign-lookup "fp-any")))
+      (let
+        ((params (get spec "params")))
+        (assert= (get (first params) "type") "any"))))
+  (deftest
+    "callback param type"
+    (define-foreign fp-cb (handler :as callback) :js "setTimeout")
+    (let
+      ((spec (foreign-lookup "fp-cb")))
+      (assert= (get (first (get spec "params")) "type") "callback"))))
+
+(defsuite
+  "foreign-binding-resolution"
+  (deftest
+    "dotted binding splits into object + method"
+    (let
+      ((resolved (foreign-resolve-binding "localStorage.getItem")))
+      (assert= (get resolved "object") "localStorage")
+      (assert= (get resolved "method") "getItem")))
+  (deftest
+    "simple binding has nil object"
+    (let
+      ((resolved (foreign-resolve-binding "parseInt")))
+      (assert= (get resolved "object") nil)
+      (assert= (get resolved "method") "parseInt")))
+  (deftest
+    "deep dotted binding preserves object path"
+    (let
+      ((resolved (foreign-resolve-binding "window.navigator.language")))
+      (assert= (get resolved "object") "window.navigator")
+      (assert= (get resolved "method") "language")))
+  (deftest
+    "single segment is method only"
+    (let
+      ((resolved (foreign-resolve-binding "alert")))
+      (assert= (get resolved "object") nil)
+      (assert= (get resolved "method") "alert"))))
+
+(defsuite
+  "foreign-kwargs"
+  (deftest
+    "returns keyword parsed correctly"
+    (define-foreign fk-ret (x :as number) :returns :number :js "Math.abs")
+    (assert= (get (foreign-lookup "fk-ret") "returns") "number"))
+  (deftest
+    "doc keyword stored"
+    (define-foreign fk-doc () :js "Date.now" :doc "Get current timestamp")
+    (assert= (get (foreign-lookup "fk-doc") "doc") "Get current timestamp"))
+  (deftest
+    "capability keyword stored"
+    (define-foreign
+      fk-cap
+      (url :as string)
+      :returns :promise
+      :js "window.fetch"
+      :capability :network)
+    (assert= (get (foreign-lookup "fk-cap") "capability") "network"))
+  (deftest
+    "promise return type"
+    (define-foreign
+      fk-async
+      (url :as string)
+      :returns :promise
+      :js "window.fetch")
+    (assert= (get (foreign-lookup "fk-async") "returns") "promise")))
+
+(defsuite
+  "foreign-build-lambda"
+  (deftest
+    "sync foreign builds non-perform lambda"
+    (define-foreign fbl-sync (x :as number) :returns :number :js "Math.abs")
+    (let
+      ((spec (foreign-lookup "fbl-sync")))
+      (let
+        ((expr (foreign-build-lambda spec)))
+        (assert (list? expr))
+        (assert= (symbol-name (first expr)) "fn"))))
+  (deftest
+    "async foreign builds perform-wrapping lambda"
+    (define-foreign
+      fbl-async
+      (url :as string)
+      :returns :promise
+      :js "window.fetch")
+    (let
+      ((spec (foreign-lookup "fbl-async")))
+      (let
+        ((expr (foreign-build-lambda spec)))
+        (assert (list? expr))
+        (let
+          ((body (nth expr 2)))
+          (assert= (symbol-name (first body)) "perform"))))))
+
+(defsuite
+  "foreign-type-checking"
+  (deftest
+    "foreign-check-args accepts correct types"
+    (foreign-check-args "test" (list {:type "number" :name "x"}) (list 42))
+    (assert true))
+  (deftest
+    "foreign-check-args rejects wrong type"
+    (let
+      ((err (guard (e (#t (error-message e))) (foreign-check-args "test" (list {:type "number" :name "x"}) (list "not-a-number")) nil)))
+      (assert (contains? err "expected number"))))
+  (deftest
+    "foreign-check-args accepts any type"
+    (foreign-check-args "test" (list {:type "any" :name "x"}) (list "hello"))
+    (foreign-check-args "test" (list {:type "any" :name "x"}) (list 42))
+    (assert true))
+  (deftest
+    "foreign-check-args rejects too few args"
+    (let
+      ((err (guard (e (#t (error-message e))) (foreign-check-args "test" (list {:type "number" :name "x"} {:type "number" :name "y"}) (list 1)) nil)))
+      (assert (contains? err "expected 2 args")))))