coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Decouple core evaluator from web platform, extract libraries

Browse Source 
The core evaluator (spec/evaluator.sx) is now the irreducible computational
core with zero web, rendering, or type-system knowledge. 2531 → 2313 lines.

- Add extensible special form registry (*custom-special-forms* + register-special-form!)
- Add render dispatch hooks (*render-check* / *render-fn*) replacing hardcoded render-active?/is-render-expr?/render-expr
- Extract freeze scopes → spec/freeze.sx (library, not core)
- Extract content addressing → spec/content.sx (library, not core)
- Move sf-deftype/sf-defeffect → spec/types.sx (self-registering)
- Move sf-defstyle → web/forms.sx (self-registering with all web forms)
- Move web tests (defpage, streaming) → web/tests/test-forms.sx
- Add is-else-clause? helper (replaces 5 inline patterns)
- Make escape-html/escape-attr library functions in render.sx (pure SX, not platform-provided)
- Add foundations plan: Step 3.5 (data representations), Step 3.7 (verified components), OCaml for Step 4d
- Update all three bootstrappers (JS 957/957, Python 744/744, OCaml 952/952)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-16 08:37:50 +00:00
parent 5ab3ecb7e0
commit 06666ac8c4
21 changed files with 886 additions and 603 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hosts/javascript/bootstrap.py
View File

@@ -131,6 +131,8 @@ def compile_ref_to_js(
# evaluator.sx = merged frames + eval utilities + CEK machine
sx_files = [
("evaluator.sx", "evaluator (frames + eval + CEK)"),
("freeze.sx", "freeze (serializable state boundaries)"),
("content.sx", "content (content-addressed computation)"),
("render.sx", "render (core)"),
]
for name in ("parser", "html", "sx", "dom", "engine", "orchestration", "boot"):

32
hosts/javascript/platform.py
View File

@@ -13,7 +13,14 @@ from shared.sx.types import Symbol
def extract_defines(source: str) -> list[tuple[str, list]]:
"""Parse .sx source, return list of (name, define-expr) for top-level defines."""
"""Parse .sx source, return list of (name, expr) for top-level forms.
Extracts (define name ...) forms with their name, plus selected
non-define top-level expressions (e.g. register-special-form! calls)
with a synthetic name for the comment.
"""
# Top-level calls that should be transpiled (not special forms)
_TOPLEVEL_CALLS = {"register-special-form!"}
exprs = parse_all(source)
defines = []
for expr in exprs:
@@ -21,6 +28,10 @@ def extract_defines(source: str) -> list[tuple[str, list]]:
if expr[0].name == "define":
name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
defines.append((name, expr))
elif expr[0].name in _TOPLEVEL_CALLS:
# Top-level call expression (e.g. register-special-form!)
call_name = expr[0].name
defines.append((f"({call_name} ...)", expr))
return defines
ADAPTER_FILES = {
@@ -283,9 +294,11 @@ ASYNC_IO_JS = '''
if (hname === "map-indexed") return asyncRenderMapIndexed(expr, env, ns);
if (hname === "for-each") return asyncRenderMap(expr, env, ns);
// define/defcomp/defmacro — eval for side effects
// define/defcomp/defmacro and custom special forms — eval for side effects
if (hname === "define" || hname === "defcomp" || hname === "defmacro" ||
hname === "defstyle" || hname === "defhandler") {
hname === "defstyle" || hname === "defhandler" ||
hname === "deftype" || hname === "defeffect" ||
(typeof _customSpecialForms !== "undefined" && _customSpecialForms[hname])) {
trampoline(evalExpr(expr, env));
return null;
}
@@ -1412,10 +1425,7 @@ PLATFORM_JS_POST = '''
var dict_fn = PRIMITIVES["dict"];
// HTML rendering helpers
function escapeHtml(s) {
return String(s).replace(/&/g,"&amp;").replace(/</g,"&lt;").replace(/>/g,"&gt;").replace(/"/g,"&quot;");
}
function escapeAttr(s) { return escapeHtml(s); }
// escape-html and escape-attr are now library functions defined in render.sx
function rawHtmlContent(r) { return r.html; }
function makeRawHtml(s) { return { _raw: true, html: s }; }
function sxExprSource(x) { return x && x.source ? x.source : String(x); }
@@ -1429,7 +1439,8 @@ PLATFORM_JS_POST = '''
function isDefinitionForm(name) {
return name === "define" || name === "defcomp" || name === "defmacro" ||
name === "defstyle" || name === "defhandler";
name === "defstyle" || name === "defhandler" ||
name === "deftype" || name === "defeffect";
}
function indexOf_(s, ch) {
@@ -1703,6 +1714,11 @@ PLATFORM_DOM_JS = """
_renderExprFn = function(expr, env) { return renderToDom(expr, env, null); };
_renderMode = true; // Browser always evaluates in render context.
// Wire CEK render hooks — evaluator checks _renderCheck/_renderFn instead of
// the old renderActiveP()/isRenderExpr()/renderExpr() triple.
_renderCheck = function(expr, env) { return isRenderExpr(expr); };
_renderFn = function(expr, env) { return renderToDom(expr, env, null); };
var SVG_NS = "http://www.w3.org/2000/svg";
var MATH_NS = "http://www.w3.org/1998/Math/MathML";

6
hosts/javascript/transpiler.sx
View File

@@ -93,6 +93,11 @@
"dispose-computed" "disposeComputed"
"with-island-scope" "withIslandScope"
"register-in-scope" "registerInScope"
"*custom-special-forms*" "_customSpecialForms"
"register-special-form!" "registerSpecialForm"
"*render-check*" "_renderCheck"
"*render-fn*" "_renderFn"
"is-else-clause?" "isElseClause"
"*batch-depth*" "_batchDepth"
"*batch-queue*" "_batchQueue"
"*store-registry*" "_storeRegistry"
@@ -181,7 +186,6 @@
"ho-some" "hoSome"
"ho-every" "hoEvery"
"ho-for-each" "hoForEach"
"sf-defstyle" "sfDefstyle"
"kf-name" "kfName"
"special-form?" "isSpecialForm"
"ho-form?" "isHoForm"

80
hosts/ocaml/bootstrap.py
View File

@@ -43,16 +43,30 @@ PREAMBLE = """\
open Sx_types
open Sx_runtime
(* Trampoline — evaluates thunks via the CEK machine.
eval_expr is defined in the transpiled block below. *)
let trampoline v = v (* CEK machine doesn't produce thunks *)
(* Trampoline — forward ref, resolved after eval_expr is defined. *)
let trampoline_fn : (value -> value) ref = ref (fun v -> v)
let trampoline v = !trampoline_fn v
(* === Mutable state for strict mode === *)
(* These are defined as top-level refs because the transpiler cannot handle
global set! mutation (it creates local refs that shadow the global). *)
let _strict_ref = ref (Bool false)
let _prim_param_types_ref = ref Nil
"""
# OCaml fixups — override iterative CEK run
# OCaml fixups — wire up trampoline + iterative CEK run
FIXUPS = """\
(* Wire up trampoline to resolve thunks via the CEK machine *)
let () = trampoline_fn := (fun v ->
match v with
| Thunk (expr, env) -> eval_expr expr (Env env)
| _ -> v)
(* Override recursive cek_run with iterative loop *)
let cek_run_iterative state =
let s = ref state in
@@ -122,7 +136,63 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
parts.append(result)
parts.append(FIXUPS)
return "\n".join(parts)
output = "\n".join(parts)
# Post-process: fix mutable globals that the transpiler can't handle.
# The transpiler emits local refs for set! targets within functions,
# but top-level globals (*strict*, *prim-param-types*) need to use
# the pre-declared refs from the preamble.
import re
# Fix *strict*: use _strict_ref instead of immutable let rec binding
output = re.sub(
r'and _strict_ =\n \(Bool false\)',
'and _strict_ = !_strict_ref',
output,
)
# Fix set-strict!: use _strict_ref instead of local ref
output = re.sub(
r'and set_strict_b val\' =\n let _strict_ = ref Nil in \(_strict_ := val\'; Nil\)',
"and set_strict_b val' =\n _strict_ref := val'; Nil",
output,
)
# Fix *prim-param-types*: use _prim_param_types_ref
output = re.sub(
r'and _prim_param_types_ =\n Nil',
'and _prim_param_types_ = !_prim_param_types_ref',
output,
)
# Fix set-prim-param-types!: use _prim_param_types_ref
output = re.sub(
r'and set_prim_param_types_b types =\n let _prim_param_types_ = ref Nil in \(_prim_param_types_ := types; Nil\)',
"and set_prim_param_types_b types =\n _prim_param_types_ref := types; Nil",
output,
)
# Fix all runtime reads of _strict_ and _prim_param_types_ to deref
# the mutable refs instead of using the stale let-rec bindings.
# This is needed because let-rec value bindings capture initial values.
# Use regex with word boundary to avoid replacing _strict_ref with
# !_strict_refref.
def fix_mutable_reads(text):
lines = text.split('\n')
fixed = []
for line in lines:
# Skip the definition lines
stripped = line.strip()
if stripped.startswith('and _strict_ =') or stripped.startswith('and _prim_param_types_ ='):
fixed.append(line)
continue
# Replace _strict_ as a standalone identifier only (not inside
# other names like set_strict_b). Match when preceded by space,
# paren, or start-of-line, and followed by space, paren, or ;.
line = re.sub(r'(?<=[ (])_strict_(?=[ );])', '!_strict_ref', line)
line = re.sub(r'(?<=[ (])_prim_param_types_(?=[ );])', '!_prim_param_types_ref', line)
fixed.append(line)
return '\n'.join(fixed)
output = fix_mutable_reads(output)
return output
def main():

116
hosts/ocaml/lib/sx_ref.ml
View File

File diff suppressed because one or more lines are too long

24
hosts/ocaml/lib/sx_runtime.ml
View File

@@ -297,10 +297,26 @@ let scope_pop _name = Nil
let provide_push name value = ignore name; ignore value; Nil
let provide_pop _name = Nil
(* Render mode stubs *)
let render_active_p () = Bool false
let render_expr _expr _env = Nil
let is_render_expr _expr = Bool false
(* Custom special forms registry — mutable dict *)
let custom_special_forms = Dict (Hashtbl.create 4)
(* register-special-form! — add a handler to the custom registry *)
let register_special_form name handler =
(match custom_special_forms with
| Dict tbl -> Hashtbl.replace tbl (value_to_str name) handler; handler
| _ -> raise (Eval_error "custom_special_forms not a dict"))
(* Render check/fn hooks — nil by default, set by platform if needed *)
let render_check = Nil
let render_fn = Nil
(* is-else-clause? — check if a cond/case test is an else marker *)
let is_else_clause v =
match v with
| Keyword k -> Bool (k = "else" || k = "default")
| Symbol s -> Bool (s = "else" || s = "default")
| Bool true -> Bool true
| _ -> Bool false
(* Signal accessors *)
let signal_value s = match s with Signal sig' -> sig'.s_value | _ -> raise (Eval_error "not a signal")

32
hosts/ocaml/transpiler.sx
View File

@@ -123,9 +123,11 @@
"provide-push!" "provide_push"
"provide-pop!" "provide_pop"
"sx-serialize" "sx_serialize"
"render-active?" "render_active_p"
"is-render-expr?" "is_render_expr"
"render-expr" "render_expr"
"*custom-special-forms*" "custom_special_forms"
"register-special-form!" "register_special_form"
"*render-check*" "render_check"
"*render-fn*" "render_fn"
"is-else-clause?" "is_else_clause"
"HTML_TAGS" "html_tags"
"VOID_ELEMENTS" "void_elements"
"BOOLEAN_ATTRS" "boolean_attrs"
@@ -192,15 +194,12 @@
"cek-call" "cek-run" "sx-call" "sx-apply"
"collect!" "collected" "clear-collected!" "context" "emit!" "emitted"
"scope-push!" "scope-pop!" "provide-push!" "provide-pop!"
"render-active?" "render-expr" "is-render-expr?"
"with-island-scope" "register-in-scope"
"signal-value" "signal-set-value" "signal-subscribers"
"signal-add-sub!" "signal-remove-sub!" "signal-deps" "signal-set-deps"
"notify-subscribers" "flush-subscribers" "dispose-computed"
"continuation?" "continuation-data" "make-cek-continuation"
"dynamic-wind-call" "strip-prefix"
"sf-defhandler" "sf-defpage" "sf-defquery" "sf-defaction"
"make-handler-def" "make-query-def" "make-action-def" "make-page-def"
"component-set-param-types!" "parse-comp-params" "parse-macro-params"
"parse-keyword-args"))
@@ -215,6 +214,15 @@
;; Check _known_defines (set by bootstrap.py)
(some (fn (d) (= d name)) _known_defines)))))
;; Dynamic globals — top-level defines that hold SX values (not functions).
;; When these appear as callees, use cek_call for dynamic dispatch.
(define ml-dynamic-globals
(list "*render-check*" "*render-fn*"))
(define ml-is-dyn-global?
(fn ((name :as string))
(some (fn (g) (= g name)) ml-dynamic-globals)))
;; Check if a variable is "dynamic" — locally bound to a non-function expression.
;; These variables hold SX values (from eval-expr, get, etc.) and need cek_call
;; when used as callees. We encode this in the set-vars list as "dyn:name".
@@ -421,8 +429,12 @@
(let ((head (first expr))
(args (rest expr)))
(if (not (= (type-of head) "symbol"))
;; Data list
(str "[" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) expr)) "]")
;; Non-symbol head: if head is a list (call expr), dispatch via cek_call;
;; otherwise treat as data list
(if (list? head)
(str "(cek_call (" (ml-expr-inner head set-vars)
") (List [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "]))")
(str "[" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) expr)) "]"))
(let ((op (symbol-name head)))
(cond
;; fn/lambda
@@ -607,8 +619,8 @@
;; Regular function call
:else
(let ((callee (ml-mangle op)))
(if (ml-is-dyn-var? op set-vars)
;; Dynamic callee (local var bound to non-fn expr) — dispatch via cek_call
(if (or (ml-is-dyn-var? op set-vars) (ml-is-dyn-global? op))
;; Dynamic callee (local var or dynamic global) — dispatch via cek_call
(str "(cek_call (" callee ") (List [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "]))")
;; Static callee — direct OCaml call
(if (empty? args)

5
hosts/python/bootstrap.py
View File

@@ -179,6 +179,11 @@ class PyEmitter:
"*batch-depth*": "_batch_depth",
"*batch-queue*": "_batch_queue",
"*store-registry*": "_store_registry",
"*custom-special-forms*": "_custom_special_forms",
"*render-check*": "_render_check",
"*render-fn*": "_render_fn",
"register-special-form!": "register_special_form_b",
"is-else-clause?": "is_else_clause_p",
"def-store": "def_store",
"use-store": "use_store",
"clear-stores": "clear_stores",

15
hosts/python/platform.py
View File

@@ -612,13 +612,7 @@ def inspect(x):
return repr(x)
def escape_html(s):
s = str(s)
return s.replace("&", "&amp;").replace("<", "&lt;").replace(">", "&gt;").replace('"', "&quot;")
def escape_attr(s):
return escape_html(s)
# escape_html and escape_attr are now library functions defined in render.sx
def raw_html_content(x):
@@ -842,7 +836,7 @@ def _sx_parse_int(v, default=0):
"stdlib.text": '''
# stdlib.text
PRIMITIVES["pluralize"] = lambda n, s="", p="s": s if n == 1 else p
PRIMITIVES["escape"] = escape_html
PRIMITIVES["escape"] = lambda s: str(s).replace("&", "&amp;").replace("<", "&lt;").replace(">", "&gt;").replace('"', "&quot;")
PRIMITIVES["strip-tags"] = lambda s: _strip_tags(str(s))
import re as _re
@@ -1647,12 +1641,15 @@ SPEC_MODULES = {
"signals": ("signals.sx", "signals (reactive signal runtime)"),
"page-helpers": ("page-helpers.sx", "page-helpers (pure data transformation helpers)"),
"types": ("types.sx", "types (gradual type system)"),
"freeze": ("freeze.sx", "freeze (serializable state boundaries)"),
"content": ("content.sx", "content (content-addressed computation)"),
}
# Note: frames and cek are now part of evaluator.sx (always loaded as core)
# Explicit ordering for spec modules with dependencies.
# freeze depends on signals; content depends on freeze.
SPEC_MODULE_ORDER = [
"deps", "engine", "page-helpers", "router", "signals", "types",
"deps", "engine", "page-helpers", "router", "signals", "types", "freeze", "content",
]
EXTENSION_NAMES = {"continuations"}

41
hosts/python/tests/run_cek_tests.py
View File

@@ -172,9 +172,6 @@ env["sf-lambda"] = sx_ref.sf_lambda
env["sf-defcomp"] = sx_ref.sf_defcomp
env["sf-defisland"] = sx_ref.sf_defisland
env["sf-defmacro"] = sx_ref.sf_defmacro
env["sf-defstyle"] = sx_ref.sf_defstyle
env["sf-deftype"] = sx_ref.sf_deftype
env["sf-defeffect"] = sx_ref.sf_defeffect
env["sf-letrec"] = sx_ref.sf_letrec
env["sf-named-let"] = sx_ref.sf_named_let
env["sf-dynamic-wind"] = sx_ref.sf_dynamic_wind
@@ -194,10 +191,25 @@ env["ho-every"] = sx_ref.ho_every
env["ho-for-each"] = sx_ref.ho_for_each
env["call-fn"] = sx_ref.call_fn
# Render-related (stub for testing — no active rendering)
env["render-active?"] = lambda: False
env["is-render-expr?"] = lambda expr: False
env["render-expr"] = lambda expr, env: NIL
# Render dispatch globals — evaluator checks *render-check* and *render-fn*
env["*render-check*"] = NIL
env["*render-fn*"] = NIL
# Custom special forms registry — modules register forms at load time
env["*custom-special-forms*"] = {}
def _register_special_form(name, handler):
env["*custom-special-forms*"][name] = handler
return NIL
env["register-special-form!"] = _register_special_form
# is-else-clause? — check if a cond/case test is an else marker
def _is_else_clause(test):
if isinstance(test, Keyword) and test.name == "else":
return True
if isinstance(test, Symbol) and test.name in ("else", ":else"):
return True
return False
env["is-else-clause?"] = _is_else_clause
# Scope primitives
env["scope-push!"] = sx_ref.PRIMITIVES.get("scope-push!", lambda *a: NIL)
@@ -214,15 +226,12 @@ env["call-thunk"] = lambda f, e: f() if callable(f) else trampoline(eval_expr([f
# Mutation helpers used by parse-keyword-args etc
env["dict-get"] = lambda d, k: d.get(k, NIL) if isinstance(d, dict) else NIL
# defhandler, defpage, defquery, defaction — these are registrations
# Use the bootstrapped versions if they exist, otherwise stub
for name in ["sf-defhandler", "sf-defpage", "sf-defquery", "sf-defaction"]:
pyname = name.replace("-", "_")
fn = getattr(sx_ref, pyname, None)
if fn:
env[name] = fn
else:
env[name] = lambda args, e, _n=name: NIL
# defstyle, defhandler, defpage, defquery, defaction — now registered via
# register-special-form! by forms.sx at load time. Stub them here in case
# forms.sx is not loaded (CEK tests don't load it).
for form_name in ["defstyle", "defhandler", "defpage", "defquery", "defaction"]:
if form_name not in env["*custom-special-forms*"]:
env["*custom-special-forms*"][form_name] = lambda args, e, _n=form_name: NIL
# Load test framework
with open(os.path.join(_SPEC_TESTS, "test-framework.sx")) as f:

23
hosts/python/tests/run_tests.py
View File

@@ -248,9 +248,26 @@ env["macro-closure"] = lambda m: m.closure
env["symbol-name"] = lambda s: s.name if isinstance(s, Symbol) else str(s)
env["keyword-name"] = lambda k: k.name if isinstance(k, Keyword) else str(k)
env["sx-serialize"] = sx_ref.sx_serialize if hasattr(sx_ref, "sx_serialize") else lambda x: str(x)
env["is-render-expr?"] = lambda expr: False
env["render-active?"] = lambda: False
env["render-expr"] = lambda expr, env: NIL
# Render dispatch globals — evaluator checks *render-check* and *render-fn*
env["*render-check*"] = NIL
env["*render-fn*"] = NIL
# Custom special forms registry — modules register forms at load time
env["*custom-special-forms*"] = {}
def _register_special_form(name, handler):
env["*custom-special-forms*"][name] = handler
return NIL
env["register-special-form!"] = _register_special_form
# is-else-clause? — check if a cond/case test is an else marker
def _is_else_clause(test):
if isinstance(test, Keyword) and test.name == "else":
return True
if isinstance(test, Symbol) and test.name in ("else", ":else"):
return True
return False
env["is-else-clause?"] = _is_else_clause
# Strict mode stubs (not yet bootstrapped to Python — no-ops for now)
env["set-strict!"] = lambda val: NIL

5
hosts/python/transpiler.sx
View File

@@ -93,6 +93,11 @@
"*batch-depth*" "_batch_depth"
"*batch-queue*" "_batch_queue"
"*store-registry*" "_store_registry"
"*custom-special-forms*" "_custom_special_forms"
"*render-check*" "_render_check"
"*render-fn*" "_render_fn"
"register-special-form!" "register_special_form_b"
"is-else-clause?" "is_else_clause_p"
"def-store" "def_store"
"use-store" "use_store"
"clear-stores" "clear_stores"

48
spec/content.sx Normal file
View File

@@ -0,0 +1,48 @@
;; ==========================================================================
;; content.sx — Content-addressed computation
;;
;; Hash frozen SX to a content identifier. Store and retrieve by CID.
;; The content IS the address — same SX always produces the same CID.
;;
;; This is a library built on top of freeze.sx. It is NOT part of the
;; core evaluator. Load order: evaluator.sx → freeze.sx → content.sx
;;
;; Uses an in-memory content store. Applications can persist to
;; localStorage or IPFS by providing their own store backend.
;; ==========================================================================
(define content-store (dict))
(define content-hash :effects []
(fn (sx-text)
;; djb2 hash → hex string. Simple, deterministic, fast.
;; Real deployment would use SHA-256 / multihash.
(let ((hash 5381))
(for-each (fn (i)
(set! hash (mod (+ (* hash 33) (char-code-at sx-text i)) 4294967296)))
(range 0 (len sx-text)))
(to-hex hash))))
(define content-put :effects [mutation]
(fn (sx-text)
(let ((cid (content-hash sx-text)))
(dict-set! content-store cid sx-text)
cid)))
(define content-get :effects []
(fn (cid)
(get content-store cid)))
;; Freeze a scope → store → return CID
(define freeze-to-cid :effects [mutation]
(fn (scope-name)
(let ((sx-text (freeze-to-sx scope-name)))
(content-put sx-text))))
;; Thaw from CID → look up → restore
(define thaw-from-cid :effects [mutation]
(fn (cid)
(let ((sx-text (content-get cid)))
(when sx-text
(thaw-from-sx sx-text)
true))))

312
spec/evaluator.sx
View File

@@ -306,6 +306,26 @@
(scan kont (list))))
;; --------------------------------------------------------------------------
;; Extension points — custom special forms and render dispatch
;; --------------------------------------------------------------------------
;;
;; Extensions (web forms, type system, etc.) register handlers here.
;; The evaluator calls these from step-eval-list after core forms.
(define *custom-special-forms* (dict))
(define register-special-form!
(fn ((name :as string) handler)
(dict-set! *custom-special-forms* name handler)))
;; Render dispatch — installed by web adapters, nil when no renderer active.
;; *render-check*: (expr env) → boolean — should this expression be rendered?
;; *render-fn*: (expr env) → value — render and return result
(define *render-check* nil)
(define *render-fn* nil)
;; **************************************************************************
;; Part 2: Evaluation Utilities
;; **************************************************************************
@@ -545,6 +565,14 @@
(every? (fn (c) (and (= (type-of c) "list") (= (len c) 2)))
clauses)))
;; is-else-clause? — check if a cond/case test is an else marker
(define is-else-clause?
(fn (test)
(or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
(and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else"))))))
;; Named let: (let name ((x 0) (y 1)) body...)
;; Desugars to a self-recursive lambda called with initial values.
@@ -755,91 +783,6 @@
(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"))
@@ -1126,10 +1069,11 @@
;; (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)
;; Extension hooks (set by web adapters, type system, etc.):
;; *custom-special-forms* — dict of name → handler fn
;; register-special-form! — (name handler) → registers custom form
;; *render-check* — nil or (expr env) → boolean
;; *render-fn* — nil or (expr env) → value
;; --------------------------------------------------------------------------
@@ -1262,13 +1206,6 @@
(= name "defcomp") (make-cek-value (sf-defcomp args env) env kont)
(= name "defisland") (make-cek-value (sf-defisland args env) env kont)
(= name "defmacro") (make-cek-value (sf-defmacro args env) env kont)
(= name "defstyle") (make-cek-value (sf-defstyle args env) env kont)
(= name "defhandler") (make-cek-value (sf-defhandler args env) env kont)
(= name "defpage") (make-cek-value (sf-defpage args env) env kont)
(= name "defquery") (make-cek-value (sf-defquery args env) env kont)
(= name "defaction") (make-cek-value (sf-defaction args env) env kont)
(= name "deftype") (make-cek-value (sf-deftype args env) env kont)
(= name "defeffect") (make-cek-value (sf-defeffect args env) env kont)
(= name "begin") (step-sf-begin args env kont)
(= name "do") (step-sf-begin args env kont)
(= name "quote") (make-cek-value (if (empty? args) nil (first args)) env kont)
@@ -1303,14 +1240,20 @@
(= name "every?") (step-ho-every args env kont)
(= name "for-each") (step-ho-for-each args env kont)
;; Custom special forms (registered by extensions)
(has-key? *custom-special-forms* name)
(make-cek-value
((get *custom-special-forms* name) args env)
env kont)
;; Macro expansion
(and (env-has? env name) (macro? (env-get env name)))
(let ((mac (env-get env name)))
(make-cek-state (expand-macro mac args env) env kont))
;; Render expression
(and (render-active?) (is-render-expr? expr))
(make-cek-value (render-expr expr env) env kont)
;; Render dispatch (installed by web adapters)
(and *render-check* (*render-check* expr env))
(make-cek-value (*render-fn* expr env) env kont)
;; Fall through to function call
:else (step-eval-call head args env kont)))
@@ -1451,11 +1394,7 @@
(let ((clause (first args))
(test (first clause)))
;; Check for :else / else
(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")))
(if (is-else-clause? test)
(make-cek-state (nth clause 1) env kont)
(make-cek-state
test env
@@ -1464,10 +1403,7 @@
(if (< (len args) 2)
(make-cek-value nil env kont)
(let ((test (first args)))
(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"))))
(if (is-else-clause? test)
(make-cek-state (nth args 1) env kont)
(make-cek-state
test env
@@ -1950,11 +1886,7 @@
(make-cek-value nil fenv rest-k)
(let ((next-clause (first next-clauses))
(next-test (first next-clause)))
(if (or (and (= (type-of next-test) "symbol")
(or (= (symbol-name next-test) "else")
(= (symbol-name next-test) ":else")))
(and (= (type-of next-test) "keyword")
(= (keyword-name next-test) "else")))
(if (is-else-clause? next-test)
(make-cek-state (nth next-clause 1) fenv rest-k)
(make-cek-state
next-test fenv
@@ -1966,10 +1898,7 @@
(if (< (len next) 2)
(make-cek-value nil fenv rest-k)
(let ((next-test (first next)))
(if (or (and (= (type-of next-test) "keyword") (= (keyword-name next-test) "else"))
(and (= (type-of next-test) "symbol")
(or (= (symbol-name next-test) "else")
(= (symbol-name next-test) ":else"))))
(if (is-else-clause? next-test)
(make-cek-state (nth next 1) fenv rest-k)
(make-cek-state
next-test fenv
@@ -2336,10 +2265,7 @@
(make-cek-value nil env kont)
(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"))))
(if (is-else-clause? test)
(make-cek-state body env kont)
;; Evaluate test expression
(let ((test-val (trampoline (eval-expr test env))))
@@ -2368,150 +2294,6 @@
val)))
;; --------------------------------------------------------------------------
;; 13. Freeze scopes — named serializable state boundaries
;; --------------------------------------------------------------------------
;;
;; A freeze scope collects signals registered within it. On freeze,
;; their current values are serialized to SX. On thaw, values are
;; restored. Multiple named scopes can coexist independently.
;;
;; Uses the scoped effects system: scope-push!/scope-pop!/context.
;;
;; Usage:
;; (freeze-scope "editor"
;; (let ((doc (signal "hello")))
;; (freeze-signal "doc" doc)
;; ...))
;;
;; (cek-freeze-scope "editor") → {:name "editor" :signals {:doc "hello"}}
;; (cek-thaw-scope "editor" frozen-data) → restores signal values
;; Registry of freeze scopes: name → list of {name signal} entries
(define freeze-registry (dict))
;; Register a signal in the current freeze scope
(define freeze-signal :effects [mutation]
(fn (name sig)
(let ((scope-name (context "sx-freeze-scope" nil)))
(when scope-name
(let ((entries (or (get freeze-registry scope-name) (list))))
(append! entries (dict "name" name "signal" sig))
(dict-set! freeze-registry scope-name entries))))))
;; Freeze scope delimiter — collects signals registered within body
(define freeze-scope :effects [mutation]
(fn (name body-fn)
(scope-push! "sx-freeze-scope" name)
;; Initialize empty entry list for this scope
(dict-set! freeze-registry name (list))
(cek-call body-fn nil)
(scope-pop! "sx-freeze-scope")
nil))
;; Freeze a named scope → SX dict of signal values
(define cek-freeze-scope :effects []
(fn (name)
(let ((entries (or (get freeze-registry name) (list)))
(signals-dict (dict)))
(for-each (fn (entry)
(dict-set! signals-dict
(get entry "name")
(signal-value (get entry "signal"))))
entries)
(dict "name" name "signals" signals-dict))))
;; Freeze all scopes
(define cek-freeze-all :effects []
(fn ()
(map (fn (name) (cek-freeze-scope name))
(keys freeze-registry))))
;; Thaw a named scope — restore signal values from frozen data
(define cek-thaw-scope :effects [mutation]
(fn (name frozen)
(let ((entries (or (get freeze-registry name) (list)))
(values (get frozen "signals")))
(when values
(for-each (fn (entry)
(let ((sig-name (get entry "name"))
(sig (get entry "signal"))
(val (get values sig-name)))
(when (not (nil? val))
(reset! sig val))))
entries)))))
;; Thaw all scopes from a list of frozen scope dicts
(define cek-thaw-all :effects [mutation]
(fn (frozen-list)
(for-each (fn (frozen)
(cek-thaw-scope (get frozen "name") frozen))
frozen-list)))
;; Serialize a frozen scope to SX text
(define freeze-to-sx :effects []
(fn (name)
(sx-serialize (cek-freeze-scope name))))
;; Restore from SX text
(define thaw-from-sx :effects [mutation]
(fn (sx-text)
(let ((parsed (sx-parse sx-text)))
(when (not (empty? parsed))
(let ((frozen (first parsed)))
(cek-thaw-scope (get frozen "name") frozen))))))
;; --------------------------------------------------------------------------
;; 14. Content-addressed computation
;; --------------------------------------------------------------------------
;;
;; Hash frozen SX to a content identifier. Store and retrieve by CID.
;; The content IS the address — same SX always produces the same CID.
;;
;; Uses an in-memory content store. Applications can persist to
;; localStorage or IPFS by providing their own store backend.
(define content-store (dict))
(define content-hash :effects []
(fn (sx-text)
;; djb2 hash → hex string. Simple, deterministic, fast.
;; Real deployment would use SHA-256 / multihash.
(let ((hash 5381))
(for-each (fn (i)
(set! hash (mod (+ (* hash 33) (char-code-at sx-text i)) 4294967296)))
(range 0 (len sx-text)))
(to-hex hash))))
(define content-put :effects [mutation]
(fn (sx-text)
(let ((cid (content-hash sx-text)))
(dict-set! content-store cid sx-text)
cid)))
(define content-get :effects []
(fn (cid)
(get content-store cid)))
;; Freeze a scope → store → return CID
(define freeze-to-cid :effects [mutation]
(fn (scope-name)
(let ((sx-text (freeze-to-sx scope-name)))
(content-put sx-text))))
;; Thaw from CID → look up → restore
(define thaw-from-cid :effects [mutation]
(fn (cid)
(let ((sx-text (content-get cid)))
(when sx-text
(thaw-from-sx sx-text)
true))))
;; **************************************************************************
;; eval-expr / trampoline — canonical definitions (after cek-run is defined)
;; **************************************************************************

94
spec/freeze.sx Normal file
View File

@@ -0,0 +1,94 @@
;; ==========================================================================
;; freeze.sx — Serializable state boundaries
;;
;; Freeze scopes collect signals registered within them. On freeze,
;; their current values are serialized to SX. On thaw, values are
;; restored. Multiple named scopes can coexist independently.
;;
;; This is a library built on top of the evaluator's scoped effects
;; (scope-push!/scope-pop!/context) and signal system. It is NOT
;; part of the core evaluator — it loads after evaluator.sx.
;;
;; Usage:
;; (freeze-scope "editor"
;; (let ((doc (signal "hello")))
;; (freeze-signal "doc" doc)
;; ...))
;;
;; (cek-freeze-scope "editor") → {:name "editor" :signals {:doc "hello"}}
;; (cek-thaw-scope "editor" frozen-data) → restores signal values
;; ==========================================================================
;; Registry of freeze scopes: name → list of {name signal} entries
(define freeze-registry (dict))
;; Register a signal in the current freeze scope
(define freeze-signal :effects [mutation]
(fn (name sig)
(let ((scope-name (context "sx-freeze-scope" nil)))
(when scope-name
(let ((entries (or (get freeze-registry scope-name) (list))))
(append! entries (dict "name" name "signal" sig))
(dict-set! freeze-registry scope-name entries))))))
;; Freeze scope delimiter — collects signals registered within body
(define freeze-scope :effects [mutation]
(fn (name body-fn)
(scope-push! "sx-freeze-scope" name)
;; Initialize empty entry list for this scope
(dict-set! freeze-registry name (list))
(cek-call body-fn nil)
(scope-pop! "sx-freeze-scope")
nil))
;; Freeze a named scope → SX dict of signal values
(define cek-freeze-scope :effects []
(fn (name)
(let ((entries (or (get freeze-registry name) (list)))
(signals-dict (dict)))
(for-each (fn (entry)
(dict-set! signals-dict
(get entry "name")
(signal-value (get entry "signal"))))
entries)
(dict "name" name "signals" signals-dict))))
;; Freeze all scopes
(define cek-freeze-all :effects []
(fn ()
(map (fn (name) (cek-freeze-scope name))
(keys freeze-registry))))
;; Thaw a named scope — restore signal values from frozen data
(define cek-thaw-scope :effects [mutation]
(fn (name frozen)
(let ((entries (or (get freeze-registry name) (list)))
(values (get frozen "signals")))
(when values
(for-each (fn (entry)
(let ((sig-name (get entry "name"))
(sig (get entry "signal"))
(val (get values sig-name)))
(when (not (nil? val))
(reset! sig val))))
entries)))))
;; Thaw all scopes from a list of frozen scope dicts
(define cek-thaw-all :effects [mutation]
(fn (frozen-list)
(for-each (fn (frozen)
(cek-thaw-scope (get frozen "name") frozen))
frozen-list)))
;; Serialize a frozen scope to SX text
(define freeze-to-sx :effects []
(fn (name)
(sx-serialize (cek-freeze-scope name))))
;; Restore from SX text
(define thaw-from-sx :effects [mutation]
(fn (sx-text)
(let ((parsed (sx-parse sx-text)))
(when (not (empty? parsed))
(let ((frozen (first parsed)))
(cek-thaw-scope (get frozen "name") frozen))))))

32
spec/render.sx
View File

@@ -146,11 +146,7 @@
(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")))
(if (is-else-clause? test)
body
(if (trampoline (eval-expr test env))
body
@@ -162,10 +158,7 @@
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"))))
(if (is-else-clause? test)
body
(if (trampoline (eval-expr test env))
body
@@ -250,13 +243,28 @@
(keys spread-dict))))
;; --------------------------------------------------------------------------
;; HTML escaping — library functions (pure text processing)
;; --------------------------------------------------------------------------
(define escape-html
(fn (s)
(-> (str s)
(replace "&" "&amp;")
(replace "<" "&lt;")
(replace ">" "&gt;")
(replace "\"" "&quot;"))))
(define escape-attr
(fn (s)
(escape-html s)))
;; --------------------------------------------------------------------------
;; Platform interface (shared across adapters)
;; --------------------------------------------------------------------------
;;
;; HTML/attribute escaping (used by HTML and SX wire adapters):
;; (escape-html s) → HTML-escaped string
;; (escape-attr s) → attribute-value-escaped string
;; Raw HTML (marker type for unescaped content):
;; (raw-html-content r) → unwrap RawHTML marker to string
;;
;; Spread (render-time attribute injection):

178
spec/tests/test-eval.sx
View File

@@ -566,181 +566,3 @@
(assert-equal 0 (len (list)))
(assert-equal "" (str))))
;; --------------------------------------------------------------------------
;; Server-only tests — skip in browser (defpage, streaming functions)
;; These require forms.sx which is only loaded server-side.
;; --------------------------------------------------------------------------
(when (get (try-call (fn () stream-chunk-id)) "ok")
(defsuite "defpage"
(deftest "basic defpage returns page-def"
(let ((p (defpage test-basic :path "/test" :auth :public :content (div "hello"))))
(assert-true (not (nil? p)))
(assert-equal "test-basic" (get p "name"))
(assert-equal "/test" (get p "path"))
(assert-equal "public" (get p "auth"))))
(deftest "defpage content expr is unevaluated AST"
(let ((p (defpage test-content :path "/c" :auth :public :content (~my-comp :title "hi"))))
(assert-true (not (nil? (get p "content"))))))
(deftest "defpage with :stream"
(let ((p (defpage test-stream :path "/s" :auth :public :stream true :content (div "x"))))
(assert-equal true (get p "stream"))))
(deftest "defpage with :shell"
(let ((p (defpage test-shell :path "/sh" :auth :public :stream true
:shell (~my-layout (~suspense :id "data" :fallback (div "loading...")))
:content (~my-streamed :data data-val))))
(assert-true (not (nil? (get p "shell"))))
(assert-true (not (nil? (get p "content"))))))
(deftest "defpage with :fallback"
(let ((p (defpage test-fallback :path "/f" :auth :public :stream true
:fallback (div :class "skeleton" "loading")
:content (div "done"))))
(assert-true (not (nil? (get p "fallback"))))))
(deftest "defpage with :data"
(let ((p (defpage test-data :path "/d" :auth :public
:data (fetch-items)
:content (~items-list :items items))))
(assert-true (not (nil? (get p "data"))))))
(deftest "defpage missing fields are nil"
(let ((p (defpage test-minimal :path "/m" :auth :public :content (div "x"))))
(assert-nil (get p "data"))
(assert-nil (get p "filter"))
(assert-nil (get p "aside"))
(assert-nil (get p "menu"))
(assert-nil (get p "shell"))
(assert-nil (get p "fallback"))
(assert-equal false (get p "stream")))))
;; --------------------------------------------------------------------------
;; Multi-stream data protocol (from forms.sx)
;; --------------------------------------------------------------------------
(defsuite "stream-chunk-id"
(deftest "extracts stream-id from chunk"
(assert-equal "my-slot" (stream-chunk-id {"stream-id" "my-slot" "x" 1})))
(deftest "defaults to stream-content when missing"
(assert-equal "stream-content" (stream-chunk-id {"x" 1 "y" 2}))))
(defsuite "stream-chunk-bindings"
(deftest "removes stream-id from chunk"
(let ((bindings (stream-chunk-bindings {"stream-id" "slot" "name" "alice" "age" 30})))
(assert-equal "alice" (get bindings "name"))
(assert-equal 30 (get bindings "age"))
(assert-nil (get bindings "stream-id"))))
(deftest "returns all keys when no stream-id"
(let ((bindings (stream-chunk-bindings {"a" 1 "b" 2})))
(assert-equal 1 (get bindings "a"))
(assert-equal 2 (get bindings "b")))))
(defsuite "normalize-binding-key"
(deftest "converts underscores to hyphens"
(assert-equal "my-key" (normalize-binding-key "my_key")))
(deftest "leaves hyphens unchanged"
(assert-equal "my-key" (normalize-binding-key "my-key")))
(deftest "handles multiple underscores"
(assert-equal "a-b-c" (normalize-binding-key "a_b_c"))))
(defsuite "bind-stream-chunk"
(deftest "creates fresh env with bindings"
(let ((base {"existing" 42})
(chunk {"stream-id" "slot" "user-name" "bob" "count" 5})
(env (bind-stream-chunk chunk base)))
;; Base env bindings are preserved
(assert-equal 42 (get env "existing"))
;; Chunk bindings are added (stream-id removed)
(assert-equal "bob" (get env "user-name"))
(assert-equal 5 (get env "count"))
;; stream-id is not in env
(assert-nil (get env "stream-id"))))
(deftest "isolates env from base — bindings don't leak to base"
(let ((base {"x" 1})
(chunk {"stream-id" "s" "y" 2})
(env (bind-stream-chunk chunk base)))
;; Chunk bindings should not appear in base
(assert-nil (get base "y"))
;; Base bindings should be in derived env
(assert-equal 1 (get env "x")))))
(defsuite "validate-stream-data"
(deftest "valid: list of dicts"
(assert-true (validate-stream-data
(list {"stream-id" "a" "x" 1}
{"stream-id" "b" "y" 2}))))
(deftest "valid: empty list"
(assert-true (validate-stream-data (list))))
(deftest "invalid: single dict (not a list)"
(assert-equal false (validate-stream-data {"x" 1})))
(deftest "invalid: list containing non-dict"
(assert-equal false (validate-stream-data (list {"x" 1} "oops" {"y" 2})))))
;; --------------------------------------------------------------------------
;; Multi-stream end-to-end scenarios
;; --------------------------------------------------------------------------
(defsuite "multi-stream routing"
(deftest "stream-chunk-id routes different chunks to different slots"
(let ((chunks (list
{"stream-id" "stream-fast" "msg" "quick"}
{"stream-id" "stream-medium" "msg" "steady"}
{"stream-id" "stream-slow" "msg" "slow"}))
(ids (map stream-chunk-id chunks)))
(assert-equal "stream-fast" (nth ids 0))
(assert-equal "stream-medium" (nth ids 1))
(assert-equal "stream-slow" (nth ids 2))))
(deftest "bind-stream-chunk creates isolated envs per chunk"
(let ((base {"layout" "main"})
(chunk-a {"stream-id" "a" "title" "First" "count" 1})
(chunk-b {"stream-id" "b" "title" "Second" "count" 2})
(env-a (bind-stream-chunk chunk-a base))
(env-b (bind-stream-chunk chunk-b base)))
;; Each env has its own bindings
(assert-equal "First" (get env-a "title"))
(assert-equal "Second" (get env-b "title"))
(assert-equal 1 (get env-a "count"))
(assert-equal 2 (get env-b "count"))
;; Both share base
(assert-equal "main" (get env-a "layout"))
(assert-equal "main" (get env-b "layout"))
;; Neither leaks into base
(assert-nil (get base "title"))))
(deftest "normalize-binding-key applied to chunk keys"
(let ((chunk {"stream-id" "s" "user_name" "alice" "item_count" 3})
(bindings (stream-chunk-bindings chunk)))
;; Keys with underscores need normalizing for SX env
(assert-equal "alice" (get bindings "user_name"))
;; normalize-binding-key converts them
(assert-equal "user-name" (normalize-binding-key "user_name"))
(assert-equal "item-count" (normalize-binding-key "item_count"))))
(deftest "defpage stream flag defaults to false"
(let ((p (defpage test-no-stream :path "/ns" :auth :public :content (div "x"))))
(assert-equal false (get p "stream"))))
(deftest "defpage stream true recorded in page-def"
(let ((p (defpage test-with-stream :path "/ws" :auth :public
:stream true
:shell (~layout (~suspense :id "data"))
:content (~chunk :val val))))
(assert-equal true (get p "stream"))
(assert-true (not (nil? (get p "shell")))))))
) ;; end (when has-server-forms?)

89
spec/types.sx
View File

@@ -4,10 +4,13 @@
;; Registration-time type checking: zero runtime cost.
;; Annotations are optional — unannotated code defaults to `any`.
;;
;; Depends on: eval.sx (type-of, component accessors, env ops)
;; This is an optional spec module — NOT part of the core evaluator.
;; It registers deftype and defeffect via register-special-form! at load time.
;;
;; Depends on: evaluator.sx (type-of, component accessors, env ops)
;; primitives.sx, boundary.sx (return type declarations)
;;
;; Platform interface (from eval.sx, already provided):
;; Platform interface (from evaluator.sx, already provided):
;; (type-of x) → type string
;; (symbol-name s) → string
;; (keyword-name k) → string
@@ -22,6 +25,88 @@
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 0. Definition forms — deftype and defeffect
;; --------------------------------------------------------------------------
;; These were previously in evaluator.sx. Now they live here and register
;; themselves via the custom special form mechanism.
(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)))
;; Register as custom special forms
(register-special-form! "deftype" sf-deftype)
(register-special-form! "defeffect" sf-defeffect)
;; --------------------------------------------------------------------------
;; 1. Type representation
;; --------------------------------------------------------------------------

140
sx/sx/plans/foundations.sx
View File

@@ -234,6 +234,9 @@
(tr (td :class "pr-4 py-1" "3.5")
(td :class "pr-4" "Data representations")
(td :class "text-stone-400" "Planned — byte buffers + typed structs"))
(tr (td :class "pr-4 py-1" "3.7")
(td :class "pr-4" "Verified components")
(td :class "text-stone-400" "Planned — content-addressed UI trust"))
(tr (td :class "pr-4 py-1" "4")
(td :class "pr-4" "Concurrent CEK")
(td :class "text-amber-600 font-semibold" "Spec complete — implementation next"))
@@ -358,6 +361,143 @@
"A " (code "defstruct") " declaration is a type definition that the type checker can verify "
"and the compiler can exploit. On interpreted hosts, the same code runs — just slower.")
;; -----------------------------------------------------------------------
;; Step 3.7: Verified Components
;; -----------------------------------------------------------------------
(h2 :class "text-xl font-bold mt-12 mb-4" "Step 3.7: Verified Components")
(p "Content-addressed components become a trust mechanism. "
"HTTPS tells you the connection is authentic. "
"Verified components tell you the " (em "UI") " is authentic — "
"that the payment form in your browser is the exact component that was audited, "
"not a tampered copy injected by XSS, a rogue extension, or a compromised CDN.")
(h3 :class "text-lg font-semibold mt-8 mb-3" "Why SX can do this")
(p "Most frameworks can't verify UI at the component level because there's no stable identity. "
"A React component is compiled, bundled, minified, tree-shaken — "
"the thing in the browser bears no relationship to the source. In SX:")
(ul :class "list-disc pl-6 mb-4 space-y-1"
(li (strong "Components are source") " — the " (code ".sx") " definition IS the component. No compilation step that could diverge.")
(li (strong "Components are pure functions") " — same inputs, same output. Deterministic.")
(li (strong "Content addressing is built in") " — " (code "freeze-to-cid") " gives every component a CID (Step 3).")
(li (strong "The evaluator runs in the browser") " — the client can independently compute the CID of any component it receives."))
(p "Because components are pure functions defined in source form, "
"verifying the definition IS verifying the behaviour. "
"There is no gap between \"what was audited\" and \"what runs.\" "
"That gap is where every UI supply chain attack lives.")
(h3 :class "text-lg font-semibold mt-8 mb-3" "3.7a Transitive closure CID")
(p "A component's CID must cover its entire dependency tree. "
"If " (code "~bank/payment-form") " calls " (code "~bank/amount-input") " calls "
(code "~ui/text-field") ", all three definitions are part of the CID:")
(~docs/code :code
(str ";; Shallow CID — just this component's definition\n"
"(freeze-to-cid ~bank/payment-form) ;; => bafyrei..abc\n"
"\n"
";; Deep CID — component + all transitive dependencies\n"
"(freeze-to-cid-deep ~bank/payment-form) ;; => bafyrei..xyz\n"
"\n"
";; The deep CID changes if ANY dependency changes.\n"
";; A one-character change in ~ui/text-field\n"
";; produces a completely different deep CID."))
(h3 :class "text-lg font-semibold mt-8 mb-3" "3.7b Canonical serialization")
(p "For CIDs to match across hosts, the serialized form must be identical. "
"Canonical SX: no comments, no redundant whitespace, deterministic key ordering in dicts, "
"normalized number representation:")
(~docs/code :code
(str ";; These must produce the same CID on JS, Python, and OCaml:\n"
"(canonical-sx '(div :class \"card\" (p \"hello\")))\n"
";; => \"(div :class \\\"card\\\" (p \\\"hello\\\"))\"\n"
"\n"
";; Dict key ordering is sorted:\n"
"(canonical-sx '{:b 2 :a 1}) ;; => \"{:a 1 :b 2}\""))
(h3 :class "text-lg font-semibold mt-8 mb-3" "3.7c Browser verification")
(p "The client-side verification flow:")
(~docs/code :code
(str ";; Server sends component + CID via aser wire format\n"
";; Browser receives, independently computes CID, compares\n"
"\n"
";; Per-component verification\n"
"(component-verify ~bank/payment-form\n"
" :expected-cid \"bafyrei...\"\n"
" :on-mismatch :refuse) ;; or :warn, :log\n"
"\n"
";; Verify entire page component tree against published manifest\n"
"(page-verify\n"
" :manifest-url \"/.well-known/sx-manifest.json\"\n"
" :on-mismatch :refuse)\n"
"\n"
";; Query verification status (for UI indicators)\n"
"(verified? ~bank/payment-form) ;; => true/false"))
(p "Visual indicator — like the HTTPS lock icon, but for individual UI components. "
"The browser knows which components have verified CIDs and can surface this to the user.")
(h3 :class "text-lg font-semibold mt-8 mb-3" "3.7d Manifest and discovery")
(p "Publishers declare expected CIDs via a well-known manifest:")
(~docs/code :code
(str ";; .well-known/sx-manifest.json\n"
"{\"version\": 1,\n"
" \"components\": {\n"
" \"~bank/payment-form\": {\n"
" \"cid\": \"bafyrei...abc\",\n"
" \"cid-deep\": \"bafyrei...xyz\",\n"
" \"audited\": \"2026-03-01\",\n"
" \"auditor\": \"security-firm.com\"\n"
" },\n"
" \"~bank/login\": {\n"
" \"cid\": \"bafyrei...def\",\n"
" \"cid-deep\": \"bafyrei...uvw\",\n"
" \"audited\": \"2026-02-15\"\n"
" }\n"
" },\n"
" \"signature\": \"...\"\n"
"}"))
(p "Alternative discovery mechanisms:")
(ul :class "list-disc pl-6 mb-4 space-y-1"
(li (strong "DNS TXT") " — " (code "_sx-verify.bank.com TXT \"payment-form=bafyrei...\""))
(li (strong "Certificate transparency") " — append-only log of component CIDs, publicly auditable")
(li (strong "IPFS") " — the CID is the address; fetching from IPFS is self-verifying")
(li (strong "Signed manifest") " — publisher signs the manifest with their TLS key; browser verifies signature"))
(h3 :class "text-lg font-semibold mt-8 mb-3" "How this differs from SRI")
(p "Subresource Integrity (SRI) already does hash verification for " (code "<script>") " tags. "
"But SRI has three gaps that verified components close:")
(div :class "overflow-x-auto mb-6"
(table :class "min-w-full text-sm"
(thead (tr
(th :class "text-left pr-4 pb-2 font-semibold" "")
(th :class "text-left pr-4 pb-2 font-semibold" "SRI")
(th :class "text-left pb-2 font-semibold" "SX Verified Components")))
(tbody
(tr (td :class "pr-4 py-1 font-semibold" "Granularity")
(td :class "pr-4" "Whole files (a JS bundle)")
(td "Individual components"))
(tr (td :class "pr-4 py-1 font-semibold" "Who sets the hash?")
(td :class "pr-4" "The server — if compromised, serves matching hashes")
(td "Independent manifest — client verifies against external source"))
(tr (td :class "pr-4 py-1 font-semibold" "What's verified?")
(td :class "pr-4" "The file bytes — says nothing about runtime behaviour")
(td "The definition — and since components are pure functions, definition = behaviour")))))
;; -----------------------------------------------------------------------
;; Step 4: Concurrent CEK — deep spec
;; -----------------------------------------------------------------------

31
web/forms.sx
View File

@@ -1,9 +1,9 @@
;; ==========================================================================
;; forms.sx — Server-side definition forms
;; forms.sx — Web-platform definition forms
;;
;; Platform-specific special forms for declaring handlers, pages, queries,
;; and actions. These parse &key parameter lists and create typed definition
;; objects that the server runtime uses for routing and execution.
;; Platform-specific special forms for declaring styles, handlers, pages,
;; queries, and actions. These are NOT part of the core evaluator — they
;; register themselves via register-special-form! at load time.
;;
;; When SX moves to isomorphic execution, these forms will have different
;; platform bindings on client vs server. The spec stays the same — only
@@ -276,3 +276,26 @@
(fn (data)
(and (= (type-of data) "list")
(every? (fn (item) (= (type-of item) "dict")) data))))
;; --------------------------------------------------------------------------
;; defstyle — bind name to evaluated style expression
;; --------------------------------------------------------------------------
(define sf-defstyle
(fn ((args :as list) (env :as dict))
(let ((name-sym (first args))
(value (trampoline (eval-expr (nth args 1) env))))
(env-bind! env (symbol-name name-sym) value)
value)))
;; --------------------------------------------------------------------------
;; Registration — make these available as special forms in the evaluator
;; --------------------------------------------------------------------------
(register-special-form! "defstyle" sf-defstyle)
(register-special-form! "defhandler" sf-defhandler)
(register-special-form! "defpage" sf-defpage)
(register-special-form! "defquery" sf-defquery)
(register-special-form! "defaction" sf-defaction)

184
web/tests/test-forms.sx Normal file
View File

@@ -0,0 +1,184 @@
;; ==========================================================================
;; test-forms.sx — Tests for web-platform definition forms
;;
;; Requires: test-framework.sx, forms.sx loaded.
;; Tests defpage, streaming functions, and the multi-stream data protocol.
;;
;; These tests were previously in spec/tests/test-eval.sx but belong here
;; because they test web-specific forms, not the core evaluator.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; defpage — page definition form
;; --------------------------------------------------------------------------
(defsuite "defpage"
(deftest "basic defpage returns page-def"
(let ((p (defpage test-basic :path "/test" :auth :public :content (div "hello"))))
(assert-true (not (nil? p)))
(assert-equal "test-basic" (get p "name"))
(assert-equal "/test" (get p "path"))
(assert-equal "public" (get p "auth"))))
(deftest "defpage content expr is unevaluated AST"
(let ((p (defpage test-content :path "/c" :auth :public :content (~my-comp :title "hi"))))
(assert-true (not (nil? (get p "content"))))))
(deftest "defpage with :stream"
(let ((p (defpage test-stream :path "/s" :auth :public :stream true :content (div "x"))))
(assert-equal true (get p "stream"))))
(deftest "defpage with :shell"
(let ((p (defpage test-shell :path "/sh" :auth :public :stream true
:shell (~my-layout (~suspense :id "data" :fallback (div "loading...")))
:content (~my-streamed :data data-val))))
(assert-true (not (nil? (get p "shell"))))
(assert-true (not (nil? (get p "content"))))))
(deftest "defpage with :fallback"
(let ((p (defpage test-fallback :path "/f" :auth :public :stream true
:fallback (div :class "skeleton" "loading")
:content (div "done"))))
(assert-true (not (nil? (get p "fallback"))))))
(deftest "defpage with :data"
(let ((p (defpage test-data :path "/d" :auth :public
:data (fetch-items)
:content (~items-list :items items))))
(assert-true (not (nil? (get p "data"))))))
(deftest "defpage missing fields are nil"
(let ((p (defpage test-minimal :path "/m" :auth :public :content (div "x"))))
(assert-nil (get p "data"))
(assert-nil (get p "filter"))
(assert-nil (get p "aside"))
(assert-nil (get p "menu"))
(assert-nil (get p "shell"))
(assert-nil (get p "fallback"))
(assert-equal false (get p "stream")))))
;; --------------------------------------------------------------------------
;; Multi-stream data protocol
;; --------------------------------------------------------------------------
(defsuite "stream-chunk-id"
(deftest "extracts stream-id from chunk"
(assert-equal "my-slot" (stream-chunk-id {"stream-id" "my-slot" "x" 1})))
(deftest "defaults to stream-content when missing"
(assert-equal "stream-content" (stream-chunk-id {"x" 1 "y" 2}))))
(defsuite "stream-chunk-bindings"
(deftest "removes stream-id from chunk"
(let ((bindings (stream-chunk-bindings {"stream-id" "slot" "name" "alice" "age" 30})))
(assert-equal "alice" (get bindings "name"))
(assert-equal 30 (get bindings "age"))
(assert-nil (get bindings "stream-id"))))
(deftest "returns all keys when no stream-id"
(let ((bindings (stream-chunk-bindings {"a" 1 "b" 2})))
(assert-equal 1 (get bindings "a"))
(assert-equal 2 (get bindings "b")))))
(defsuite "normalize-binding-key"
(deftest "converts underscores to hyphens"
(assert-equal "my-key" (normalize-binding-key "my_key")))
(deftest "leaves hyphens unchanged"
(assert-equal "my-key" (normalize-binding-key "my-key")))
(deftest "handles multiple underscores"
(assert-equal "a-b-c" (normalize-binding-key "a_b_c"))))
(defsuite "bind-stream-chunk"
(deftest "creates fresh env with bindings"
(let ((base {"existing" 42})
(chunk {"stream-id" "slot" "user-name" "bob" "count" 5})
(env (bind-stream-chunk chunk base)))
;; Base env bindings are preserved
(assert-equal 42 (get env "existing"))
;; Chunk bindings are added (stream-id removed)
(assert-equal "bob" (get env "user-name"))
(assert-equal 5 (get env "count"))
;; stream-id is not in env
(assert-nil (get env "stream-id"))))
(deftest "isolates env from base — bindings don't leak to base"
(let ((base {"x" 1})
(chunk {"stream-id" "s" "y" 2})
(env (bind-stream-chunk chunk base)))
;; Chunk bindings should not appear in base
(assert-nil (get base "y"))
;; Base bindings should be in derived env
(assert-equal 1 (get env "x")))))
(defsuite "validate-stream-data"
(deftest "valid: list of dicts"
(assert-true (validate-stream-data
(list {"stream-id" "a" "x" 1}
{"stream-id" "b" "y" 2}))))
(deftest "valid: empty list"
(assert-true (validate-stream-data (list))))
(deftest "invalid: single dict (not a list)"
(assert-equal false (validate-stream-data {"x" 1})))
(deftest "invalid: list containing non-dict"
(assert-equal false (validate-stream-data (list {"x" 1} "oops" {"y" 2})))))
;; --------------------------------------------------------------------------
;; Multi-stream end-to-end scenarios
;; --------------------------------------------------------------------------
(defsuite "multi-stream routing"
(deftest "stream-chunk-id routes different chunks to different slots"
(let ((chunks (list
{"stream-id" "stream-fast" "msg" "quick"}
{"stream-id" "stream-medium" "msg" "steady"}
{"stream-id" "stream-slow" "msg" "slow"}))
(ids (map stream-chunk-id chunks)))
(assert-equal "stream-fast" (nth ids 0))
(assert-equal "stream-medium" (nth ids 1))
(assert-equal "stream-slow" (nth ids 2))))
(deftest "bind-stream-chunk creates isolated envs per chunk"
(let ((base {"layout" "main"})
(chunk-a {"stream-id" "a" "title" "First" "count" 1})
(chunk-b {"stream-id" "b" "title" "Second" "count" 2})
(env-a (bind-stream-chunk chunk-a base))
(env-b (bind-stream-chunk chunk-b base)))
;; Each env has its own bindings
(assert-equal "First" (get env-a "title"))
(assert-equal "Second" (get env-b "title"))
(assert-equal 1 (get env-a "count"))
(assert-equal 2 (get env-b "count"))
;; Both share base
(assert-equal "main" (get env-a "layout"))
(assert-equal "main" (get env-b "layout"))
;; Neither leaks into base
(assert-nil (get base "title"))))
(deftest "normalize-binding-key applied to chunk keys"
(let ((chunk {"stream-id" "s" "user_name" "alice" "item_count" 3})
(bindings (stream-chunk-bindings chunk)))
;; Keys with underscores need normalizing for SX env
(assert-equal "alice" (get bindings "user_name"))
;; normalize-binding-key converts them
(assert-equal "user-name" (normalize-binding-key "user_name"))
(assert-equal "item-count" (normalize-binding-key "item_count"))))
(deftest "defpage stream flag defaults to false"
(let ((p (defpage test-no-stream :path "/ns" :auth :public :content (div "x"))))
(assert-equal false (get p "stream"))))
(deftest "defpage stream true recorded in page-def"
(let ((p (defpage test-with-stream :path "/ws" :auth :public
:stream true
:shell (~layout (~suspense :id "data"))
:content (~chunk :val val))))
(assert-equal true (get p "stream"))
(assert-true (not (nil? (get p "shell")))))))