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

Add (param :as type) annotations to all fn/lambda params across SX spec

Browse Source 
Extend the type annotation system from defcomp-only to fn/lambda params:
- Infrastructure: sf-lambda, py/js-collect-params-loop, and bootstrap_py.py
  now recognize (name :as type) in param lists, extracting just the name
- bootstrap_py.py: add _extract_param_name() helper, fix _emit_for_each_stmt
- 521 type annotations across 22 .sx spec files (eval, types, adapters,
  transpilers, engine, orchestration, deps, signals, router, prove, etc.)
- Zero behavioral change: annotations are metadata for static analysis only
- All bootstrappers (Python, JS, G1) pass, 81/81 spec tests pass

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-11 20:27:36 +00:00
parent c82941d93c
commit b99e69d1bb
23 changed files with 532 additions and 498 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
shared/static/scripts/sx-browser.js
View File

@@ -14,7 +14,7 @@
// ========================================================================= // =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-03-11T17:38:00Z"; var SX_VERSION = "2026-03-11T20:12:35Z";
function isNil(x) { return x === NIL || x === null || x === undefined; } function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); } function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -881,7 +881,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
var paramsExpr = first(args); var paramsExpr = first(args);
var bodyExprs = rest(args); var bodyExprs = rest(args);
var body = (isSxTruthy((len(bodyExprs) == 1)) ? first(bodyExprs) : cons(makeSymbol("begin"), bodyExprs)); var body = (isSxTruthy((len(bodyExprs) == 1)) ? first(bodyExprs) : cons(makeSymbol("begin"), bodyExprs));
var paramNames = map(function(p) { return (isSxTruthy((typeOf(p) == "symbol")) ? symbolName(p) : p); }, paramsExpr); var paramNames = map(function(p) { return (isSxTruthy((typeOf(p) == "symbol")) ? symbolName(p) : (isSxTruthy((isSxTruthy((typeOf(p) == "list")) && isSxTruthy((len(p) == 3)) && isSxTruthy((typeOf(nth(p, 1)) == "keyword")) && (keywordName(nth(p, 1)) == "as"))) ? symbolName(first(p)) : p)); }, paramsExpr);
return makeLambda(paramNames, body, env); return makeLambda(paramNames, body, env);
})(); }; })(); };
@@ -1200,7 +1200,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
// process-bindings // process-bindings
var processBindings = function(bindings, env) { return (function() { var processBindings = function(bindings, env) { return (function() {
var local = envExtend(env); var local = envExtend(env);
{ var _c = bindings; for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; if (isSxTruthy((isSxTruthy((typeOf(pair) == "list")) && (len(pair) >= 2)))) { { var _c = bindings; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('pair'), Keyword('as'), Symbol('list')] = _c[_i]; if (isSxTruthy((isSxTruthy((typeOf(pair) == "list")) && (len(pair) >= 2)))) {
(function() { (function() {
var name = (isSxTruthy((typeOf(first(pair)) == "symbol")) ? symbolName(first(pair)) : (String(first(pair)))); var name = (isSxTruthy((typeOf(first(pair)) == "symbol")) ? symbolName(first(pair)) : (String(first(pair))));
return envSet(local, name, trampoline(evalExpr(nth(pair, 1), local))); return envSet(local, name, trampoline(evalExpr(nth(pair, 1), local)));
@@ -2171,7 +2171,7 @@ return (function() {
var tokens = split(trim(part), " "); var tokens = split(trim(part), " ");
return (isSxTruthy(isEmpty(tokens)) ? NIL : (isSxTruthy((isSxTruthy((first(tokens) == "every")) && (len(tokens) >= 2))) ? {["event"]: "every", ["modifiers"]: {["interval"]: parseTime(nth(tokens, 1))}} : (function() { return (isSxTruthy(isEmpty(tokens)) ? NIL : (isSxTruthy((isSxTruthy((first(tokens) == "every")) && (len(tokens) >= 2))) ? {["event"]: "every", ["modifiers"]: {["interval"]: parseTime(nth(tokens, 1))}} : (function() {
var mods = {}; var mods = {};
{ var _c = rest(tokens); for (var _i = 0; _i < _c.length; _i++) { var tok = _c[_i]; (isSxTruthy((tok == "once")) ? dictSet(mods, "once", true) : (isSxTruthy((tok == "changed")) ? dictSet(mods, "changed", true) : (isSxTruthy(startsWith(tok, "delay:")) ? dictSet(mods, "delay", parseTime(slice(tok, 6))) : (isSxTruthy(startsWith(tok, "from:")) ? dictSet(mods, "from", slice(tok, 5)) : NIL)))); } } { var _c = rest(tokens); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('tok'), Keyword('as'), Symbol('string')] = _c[_i]; (isSxTruthy((tok == "once")) ? dictSet(mods, "once", true) : (isSxTruthy((tok == "changed")) ? dictSet(mods, "changed", true) : (isSxTruthy(startsWith(tok, "delay:")) ? dictSet(mods, "delay", parseTime(slice(tok, 6))) : (isSxTruthy(startsWith(tok, "from:")) ? dictSet(mods, "from", slice(tok, 5)) : NIL)))); } }
return {["event"]: first(tokens), ["modifiers"]: mods}; return {["event"]: first(tokens), ["modifiers"]: mods};
})())); })()));
})(); }, rawParts)); })(); }, rawParts));
@@ -2217,7 +2217,7 @@ return (function() {
var parts = split(sxOr(rawSwap, DEFAULT_SWAP), " "); var parts = split(sxOr(rawSwap, DEFAULT_SWAP), " ");
var style = first(parts); var style = first(parts);
var useTransition = globalTransitions_p; var useTransition = globalTransitions_p;
{ var _c = rest(parts); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; (isSxTruthy((p == "transition:true")) ? (useTransition = true) : (isSxTruthy((p == "transition:false")) ? (useTransition = false) : NIL)); } } { var _c = rest(parts); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('p'), Keyword('as'), Symbol('string')] = _c[_i]; (isSxTruthy((p == "transition:true")) ? (useTransition = true) : (isSxTruthy((p == "transition:false")) ? (useTransition = false) : NIL)); } }
return {["style"]: style, ["transition"]: useTransition}; return {["style"]: style, ["transition"]: useTransition};
})(); }; })(); };
@@ -2270,7 +2270,7 @@ return (function() {
// find-oob-swaps // find-oob-swaps
var findOobSwaps = function(container) { return (function() { var findOobSwaps = function(container) { return (function() {
var results = []; var results = [];
{ var _c = ["sx-swap-oob", "hx-swap-oob"]; for (var _i = 0; _i < _c.length; _i++) { var attr = _c[_i]; (function() { { var _c = ["sx-swap-oob", "hx-swap-oob"]; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('attr'), Keyword('as'), Symbol('string')] = _c[_i]; (function() {
var oobEls = domQueryAll(container, (String("[") + String(attr) + String("]"))); var oobEls = domQueryAll(container, (String("[") + String(attr) + String("]")));
return forEach(function(oob) { return (function() { return forEach(function(oob) { return (function() {
var swapType = sxOr(domGetAttr(oob, attr), "outerHTML"); var swapType = sxOr(domGetAttr(oob, attr), "outerHTML");
@@ -2289,7 +2289,7 @@ return (function() {
var syncAttrs = function(oldEl, newEl) { return (function() { var syncAttrs = function(oldEl, newEl) { return (function() {
var raStr = sxOr(domGetAttr(oldEl, "data-sx-reactive-attrs"), ""); var raStr = sxOr(domGetAttr(oldEl, "data-sx-reactive-attrs"), "");
var reactiveAttrs = (isSxTruthy(isEmpty(raStr)) ? [] : split(raStr, ",")); var reactiveAttrs = (isSxTruthy(isEmpty(raStr)) ? [] : split(raStr, ","));
{ var _c = domAttrList(newEl); for (var _i = 0; _i < _c.length; _i++) { var attr = _c[_i]; (function() { { var _c = domAttrList(newEl); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('attr'), Keyword('as'), Symbol('list')] = _c[_i]; (function() {
var name = first(attr); var name = first(attr);
var val = nth(attr, 1); var val = nth(attr, 1);
return (isSxTruthy((isSxTruthy(!isSxTruthy((domGetAttr(oldEl, name) == val))) && !isSxTruthy(contains(reactiveAttrs, name)))) ? domSetAttr(oldEl, name, val) : NIL); return (isSxTruthy((isSxTruthy(!isSxTruthy((domGetAttr(oldEl, name) == val))) && !isSxTruthy(contains(reactiveAttrs, name)))) ? domSetAttr(oldEl, name, val) : NIL);
@@ -2543,7 +2543,7 @@ return (function() {
var headers = buildRequestHeaders(el, loadedComponentNames(), _cssHash); var headers = buildRequestHeaders(el, loadedComponentNames(), _cssHash);
var csrf = csrfToken(); var csrf = csrfToken();
if (isSxTruthy(extraParams)) { if (isSxTruthy(extraParams)) {
{ var _c = keys(extraParams); for (var _i = 0; _i < _c.length; _i++) { var k = _c[_i]; headers[k] = get(extraParams, k); } } { var _c = keys(extraParams); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('k'), Keyword('as'), Symbol('string')] = _c[_i]; headers[k] = get(extraParams, k); } }
} }
if (isSxTruthy(ct)) { if (isSxTruthy(ct)) {
headers["Content-Type"] = ct; headers["Content-Type"] = ct;
@@ -2784,7 +2784,7 @@ return domAppendToHead(link); }, domQueryAll(container, "link[rel=\"stylesheet\"
var base = pageName; var base = pageName;
return (isSxTruthy(sxOr(isNil(params), isEmpty(keys(params)))) ? base : (function() { return (isSxTruthy(sxOr(isNil(params), isEmpty(keys(params)))) ? base : (function() {
var parts = []; var parts = [];
{ var _c = keys(params); for (var _i = 0; _i < _c.length; _i++) { var k = _c[_i]; parts.push((String(k) + String("=") + String(get(params, k)))); } } { var _c = keys(params); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('k'), Keyword('as'), Symbol('string')] = _c[_i]; parts.push((String(k) + String("=") + String(get(params, k)))); } }
return (String(base) + String(":") + String(join("&", parts))); return (String(base) + String(":") + String(join("&", parts)));
})()); })());
})(); }; })(); };
@@ -2799,7 +2799,7 @@ return domAppendToHead(link); }, domQueryAll(container, "link[rel=\"stylesheet\"
var pageDataCacheSet = function(cacheKey, data) { return dictSet(_pageDataCache, cacheKey, {"data": data, "ts": nowMs()}); }; var pageDataCacheSet = function(cacheKey, data) { return dictSet(_pageDataCache, cacheKey, {"data": data, "ts": nowMs()}); };
// invalidate-page-cache // invalidate-page-cache
var invalidatePageCache = function(pageName) { { var _c = keys(_pageDataCache); for (var _i = 0; _i < _c.length; _i++) { var k = _c[_i]; if (isSxTruthy(sxOr((k == pageName), startsWith(k, (String(pageName) + String(":")))))) { var invalidatePageCache = function(pageName) { { var _c = keys(_pageDataCache); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('k'), Keyword('as'), Symbol('string')] = _c[_i]; if (isSxTruthy(sxOr((k == pageName), startsWith(k, (String(pageName) + String(":")))))) {
_pageDataCache[k] = NIL; _pageDataCache[k] = NIL;
} } } } } }
swPostMessage({"type": "invalidate", "page": pageName}); swPostMessage({"type": "invalidate", "page": pageName});
@@ -3200,7 +3200,7 @@ return (function() {
var comp = envGet(env, fullName); var comp = envGet(env, fullName);
return (isSxTruthy(!isSxTruthy(isComponent(comp))) ? error((String("Unknown component: ") + String(fullName))) : (function() { return (isSxTruthy(!isSxTruthy(isComponent(comp))) ? error((String("Unknown component: ") + String(fullName))) : (function() {
var callExpr = [makeSymbol(fullName)]; var callExpr = [makeSymbol(fullName)];
{ var _c = keys(kwargs); for (var _i = 0; _i < _c.length; _i++) { var k = _c[_i]; callExpr.push(makeKeyword(toKebab(k))); { var _c = keys(kwargs); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('k'), Keyword('as'), Symbol('string')] = _c[_i]; callExpr.push(makeKeyword(toKebab(k)));
callExpr.push(dictGet(kwargs, k)); } } callExpr.push(dictGet(kwargs, k)); } }
return renderToDom(callExpr, env, NIL); return renderToDom(callExpr, env, NIL);
})()); })());
@@ -3280,7 +3280,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var kwargs = sxOr(first(sxParse(stateSx)), {}); var kwargs = sxOr(first(sxParse(stateSx)), {});
var disposers = []; var disposers = [];
var local = envMerge(componentClosure(comp), env); var local = envMerge(componentClosure(comp), env);
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envSet(local, p, (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL)); } } { var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('p'), Keyword('as'), Symbol('string')] = _c[_i]; envSet(local, p, (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL)); } }
return (function() { return (function() {
var bodyDom = withIslandScope(function(disposable) { return append_b(disposers, disposable); }, function() { return renderToDom(componentBody(comp), local, NIL); }); var bodyDom = withIslandScope(function(disposable) { return append_b(disposers, disposable); }, function() { return renderToDom(componentBody(comp), local, NIL); });
domSetTextContent(el, ""); domSetTextContent(el, "");
@@ -3358,7 +3358,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var componentsNeeded = function(pageSource, env) { return (function() { var componentsNeeded = function(pageSource, env) { return (function() {
var direct = scanComponentsFromSource(pageSource); var direct = scanComponentsFromSource(pageSource);
var allNeeded = []; var allNeeded = [];
{ var _c = direct; for (var _i = 0; _i < _c.length; _i++) { var name = _c[_i]; if (isSxTruthy(!isSxTruthy(contains(allNeeded, name)))) { { var _c = direct; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('name'), Keyword('as'), Symbol('string')] = _c[_i]; if (isSxTruthy(!isSxTruthy(contains(allNeeded, name)))) {
allNeeded.push(name); allNeeded.push(name);
} }
(function() { (function() {
@@ -3378,11 +3378,11 @@ callExpr.push(dictGet(kwargs, k)); } }
var pageCssClasses = function(pageSource, env) { return (function() { var pageCssClasses = function(pageSource, env) { return (function() {
var needed = componentsNeeded(pageSource, env); var needed = componentsNeeded(pageSource, env);
var classes = []; var classes = [];
{ var _c = needed; for (var _i = 0; _i < _c.length; _i++) { var name = _c[_i]; (function() { { var _c = needed; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('name'), Keyword('as'), Symbol('string')] = _c[_i]; (function() {
var val = envGet(env, name); var val = envGet(env, name);
return (isSxTruthy((typeOf(val) == "component")) ? forEach(function(cls) { return (isSxTruthy(!isSxTruthy(contains(classes, cls))) ? append_b(classes, cls) : NIL); }, componentCssClasses(val)) : NIL); return (isSxTruthy((typeOf(val) == "component")) ? forEach(function(cls) { return (isSxTruthy(!isSxTruthy(contains(classes, cls))) ? append_b(classes, cls) : NIL); }, componentCssClasses(val)) : NIL);
})(); } } })(); } }
{ var _c = scanCssClasses(pageSource); for (var _i = 0; _i < _c.length; _i++) { var cls = _c[_i]; if (isSxTruthy(!isSxTruthy(contains(classes, cls)))) { { var _c = scanCssClasses(pageSource); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('cls'), Keyword('as'), Symbol('string')] = _c[_i]; if (isSxTruthy(!isSxTruthy(contains(classes, cls)))) {
classes.push(cls); classes.push(cls);
} } } } } }
return classes; return classes;
@@ -3459,7 +3459,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var serverList = []; var serverList = [];
var clientList = []; var clientList = [];
var ioDeps = []; var ioDeps = [];
{ var _c = needed; for (var _i = 0; _i < _c.length; _i++) { var name = _c[_i]; (function() { { var _c = needed; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('name'), Keyword('as'), Symbol('string')] = _c[_i]; (function() {
var target = renderTarget(name, env, ioNames); var target = renderTarget(name, env, ioNames);
compTargets[name] = target; compTargets[name] = target;
return (isSxTruthy((target == "server")) ? (append_b(serverList, name), forEach(function(ioRef) { return (isSxTruthy(!isSxTruthy(contains(ioDeps, ioRef))) ? append_b(ioDeps, ioRef) : NIL); }, componentIoRefsCached(name, env, ioNames))) : append_b(clientList, name)); return (isSxTruthy((target == "server")) ? (append_b(serverList, name), forEach(function(ioRef) { return (isSxTruthy(!isSxTruthy(contains(ioDeps, ioRef))) ? append_b(ioDeps, ioRef) : NIL); }, componentIoRefsCached(name, env, ioNames))) : append_b(clientList, name));
@@ -3484,7 +3484,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var result = {}; var result = {};
var items = slice(expr, 2); var items = slice(expr, 2);
var n = len(items); var n = len(items);
{ var _c = range(0, n); for (var _i = 0; _i < _c.length; _i++) { var idx = _c[_i]; if (isSxTruthy((isSxTruthy(((idx + 1) < n)) && (typeOf(nth(items, idx)) == "keyword")))) { { var _c = range(0, n); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('idx'), Keyword('as'), Symbol('number')] = _c[_i]; if (isSxTruthy((isSxTruthy(((idx + 1) < n)) && (typeOf(nth(items, idx)) == "keyword")))) {
(function() { (function() {
var key = keywordName(nth(items, idx)); var key = keywordName(nth(items, idx));
var val = nth(items, (idx + 1)); var val = nth(items, (idx + 1));
@@ -3524,7 +3524,7 @@ callExpr.push(dictGet(kwargs, k)); } }
})()); }, items); }; })()); }, items); };
// build-reference-data // build-reference-data
var buildReferenceData = function(slug, rawData, detailKeys) { return (function() { var _m = slug; if (_m == "attributes") return {"req-attrs": buildRefItemsWithHref(get(rawData, "req-attrs"), "/hypermedia/reference/attributes/", detailKeys, 3), "beh-attrs": buildRefItemsWithHref(get(rawData, "beh-attrs"), "/hypermedia/reference/attributes/", detailKeys, 3), "uniq-attrs": buildRefItemsWithHref(get(rawData, "uniq-attrs"), "/hypermedia/reference/attributes/", detailKeys, 3)}; if (_m == "headers") return {"req-headers": buildRefItemsWithHref(get(rawData, "req-headers"), "/hypermedia/reference/headers/", detailKeys, 3), "resp-headers": buildRefItemsWithHref(get(rawData, "resp-headers"), "/hypermedia/reference/headers/", detailKeys, 3)}; if (_m == "events") return {"events-list": buildRefItemsWithHref(get(rawData, "events-list"), "/hypermedia/reference/events/", detailKeys, 2)}; if (_m == "js-api") return {"js-api-list": map(function(item) { return {"name": nth(item, 0), "desc": nth(item, 1)}; }, get(rawData, "js-api-list"))}; return {"req-attrs": buildRefItemsWithHref(get(rawData, "req-attrs"), "/hypermedia/reference/attributes/", detailKeys, 3), "beh-attrs": buildRefItemsWithHref(get(rawData, "beh-attrs"), "/hypermedia/reference/attributes/", detailKeys, 3), "uniq-attrs": buildRefItemsWithHref(get(rawData, "uniq-attrs"), "/hypermedia/reference/attributes/", detailKeys, 3)}; })(); }; var buildReferenceData = function(slug, rawData, detailKeys) { return (function() { var _m = slug; if (_m == "attributes") return {"req-attrs": buildRefItemsWithHref(get(rawData, "req-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "beh-attrs": buildRefItemsWithHref(get(rawData, "beh-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "uniq-attrs": buildRefItemsWithHref(get(rawData, "uniq-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3)}; if (_m == "headers") return {"req-headers": buildRefItemsWithHref(get(rawData, "req-headers"), "/geography/hypermedia/reference/headers/", detailKeys, 3), "resp-headers": buildRefItemsWithHref(get(rawData, "resp-headers"), "/geography/hypermedia/reference/headers/", detailKeys, 3)}; if (_m == "events") return {"events-list": buildRefItemsWithHref(get(rawData, "events-list"), "/geography/hypermedia/reference/events/", detailKeys, 2)}; if (_m == "js-api") return {"js-api-list": map(function(item) { return {"name": nth(item, 0), "desc": nth(item, 1)}; }, get(rawData, "js-api-list"))}; return {"req-attrs": buildRefItemsWithHref(get(rawData, "req-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "beh-attrs": buildRefItemsWithHref(get(rawData, "beh-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "uniq-attrs": buildRefItemsWithHref(get(rawData, "uniq-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3)}; })(); };
// build-attr-detail // build-attr-detail
var buildAttrDetail = function(slug, detail) { return (isSxTruthy(isNil(detail)) ? {"attr-not-found": true} : {"attr-not-found": NIL, "attr-title": slug, "attr-description": get(detail, "description"), "attr-example": get(detail, "example"), "attr-handler": get(detail, "handler"), "attr-demo": get(detail, "demo"), "attr-wire-id": (isSxTruthy(dictHas(detail, "handler")) ? (String("ref-wire-") + String(replace_(replace_(slug, ":", "-"), "*", "star"))) : NIL)}); }; var buildAttrDetail = function(slug, detail) { return (isSxTruthy(isNil(detail)) ? {"attr-not-found": true} : {"attr-not-found": NIL, "attr-title": slug, "attr-description": get(detail, "description"), "attr-example": get(detail, "example"), "attr-handler": get(detail, "handler"), "attr-demo": get(detail, "demo"), "attr-wire-id": (isSxTruthy(dictHas(detail, "handler")) ? (String("ref-wire-") + String(replace_(replace_(slug, ":", "-"), "*", "star"))) : NIL)}); };
@@ -3555,7 +3555,7 @@ callExpr.push(dictGet(kwargs, k)); } }
// build-bundle-analysis // build-bundle-analysis
var buildBundleAnalysis = function(pagesRaw, componentsRaw, totalComponents, totalMacros, pureCount, ioCount) { return (function() { var buildBundleAnalysis = function(pagesRaw, componentsRaw, totalComponents, totalMacros, pureCount, ioCount) { return (function() {
var pagesData = []; var pagesData = [];
{ var _c = pagesRaw; for (var _i = 0; _i < _c.length; _i++) { var page = _c[_i]; (function() { { var _c = pagesRaw; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('page'), Keyword('as'), Symbol('dict')] = _c[_i]; (function() {
var neededNames = get(page, "needed-names"); var neededNames = get(page, "needed-names");
var n = len(neededNames); var n = len(neededNames);
var pct = (isSxTruthy((totalComponents > 0)) ? round(((n / totalComponents) * 100)) : 0); var pct = (isSxTruthy((totalComponents > 0)) ? round(((n / totalComponents) * 100)) : 0);
@@ -3564,7 +3564,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var ioInPage = 0; var ioInPage = 0;
var pageIoRefs = []; var pageIoRefs = [];
var compDetails = []; var compDetails = [];
{ var _c = neededNames; for (var _i = 0; _i < _c.length; _i++) { var compName = _c[_i]; (function() { { var _c = neededNames; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('compName'), Keyword('as'), Symbol('string')] = _c[_i]; (function() {
var info = get(componentsRaw, compName); var info = get(componentsRaw, compName);
return (isSxTruthy(!isSxTruthy(isNil(info))) ? ((isSxTruthy(get(info, "is-pure")) ? (pureInPage = (pureInPage + 1)) : ((ioInPage = (ioInPage + 1)), forEach(function(ref) { return (isSxTruthy(!isSxTruthy(some(function(r) { return (r == ref); }, pageIoRefs))) ? append_b(pageIoRefs, ref) : NIL); }, sxOr(get(info, "io-refs"), [])))), append_b(compDetails, {"name": compName, "is-pure": get(info, "is-pure"), "affinity": get(info, "affinity"), "render-target": get(info, "render-target"), "io-refs": sxOr(get(info, "io-refs"), []), "deps": sxOr(get(info, "deps"), []), "source": get(info, "source")})) : NIL); return (isSxTruthy(!isSxTruthy(isNil(info))) ? ((isSxTruthy(get(info, "is-pure")) ? (pureInPage = (pureInPage + 1)) : ((ioInPage = (ioInPage + 1)), forEach(function(ref) { return (isSxTruthy(!isSxTruthy(some(function(r) { return (r == ref); }, pageIoRefs))) ? append_b(pageIoRefs, ref) : NIL); }, sxOr(get(info, "io-refs"), [])))), append_b(compDetails, {"name": compName, "is-pure": get(info, "is-pure"), "affinity": get(info, "affinity"), "render-target": get(info, "render-target"), "io-refs": sxOr(get(info, "io-refs"), []), "deps": sxOr(get(info, "deps"), []), "source": get(info, "source")})) : NIL);
})(); } } })(); } }
@@ -3578,7 +3578,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var pagesData = []; var pagesData = [];
var clientCount = 0; var clientCount = 0;
var serverCount = 0; var serverCount = 0;
{ var _c = pagesRaw; for (var _i = 0; _i < _c.length; _i++) { var page = _c[_i]; (function() { { var _c = pagesRaw; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('page'), Keyword('as'), Symbol('dict')] = _c[_i]; (function() {
var hasData = get(page, "has-data"); var hasData = get(page, "has-data");
var contentSrc = sxOr(get(page, "content-src"), ""); var contentSrc = sxOr(get(page, "content-src"), "");
var mode = NIL; var mode = NIL;
@@ -3649,7 +3649,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var findMatchingRoute = function(path, routes) { return (function() { var findMatchingRoute = function(path, routes) { return (function() {
var pathSegs = splitPathSegments(path); var pathSegs = splitPathSegments(path);
var result = NIL; var result = NIL;
{ var _c = routes; for (var _i = 0; _i < _c.length; _i++) { var route = _c[_i]; if (isSxTruthy(isNil(result))) { { var _c = routes; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('route'), Keyword('as'), Symbol('dict')] = _c[_i]; if (isSxTruthy(isNil(result))) {
(function() { (function() {
var params = matchRouteSegments(pathSegs, get(route, "parsed")); var params = matchRouteSegments(pathSegs, get(route, "parsed"));
return (isSxTruthy(!isSxTruthy(isNil(params))) ? (function() { return (isSxTruthy(!isSxTruthy(isNil(params))) ? (function() {
@@ -3697,7 +3697,7 @@ callExpr.push(dictGet(kwargs, k)); } }
var deps = []; var deps = [];
var computeCtx = NIL; var computeCtx = NIL;
return (function() { return (function() {
var recompute = function() { { var _c = signalDeps(s); for (var _i = 0; _i < _c.length; _i++) { var dep = _c[_i]; signalRemoveSub(dep, recompute); } } var recompute = function() { { var _c = signalDeps(s); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('dep'), Keyword('as'), Symbol('signal')] = _c[_i]; signalRemoveSub(dep, recompute); } }
signalSetDeps(s, []); signalSetDeps(s, []);
return (function() { return (function() {
var ctx = makeTrackingContext(recompute); var ctx = makeTrackingContext(recompute);
@@ -3747,7 +3747,7 @@ return (function() {
if (isSxTruthy(cleanupFn)) { if (isSxTruthy(cleanupFn)) {
invoke(cleanupFn); invoke(cleanupFn);
} }
{ var _c = deps; for (var _i = 0; _i < _c.length; _i++) { var dep = _c[_i]; signalRemoveSub(dep, runEffect); } } { var _c = deps; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('dep'), Keyword('as'), Symbol('signal')] = _c[_i]; signalRemoveSub(dep, runEffect); } }
return (deps = []); }; return (deps = []); };
registerInScope(disposeFn); registerInScope(disposeFn);
return disposeFn; return disposeFn;
@@ -3771,7 +3771,7 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
return (function() { return (function() {
var seen = []; var seen = [];
var pending = []; var pending = [];
{ var _c = queue; for (var _i = 0; _i < _c.length; _i++) { var s = _c[_i]; { var _c = signalSubscribers(s); for (var _i = 0; _i < _c.length; _i++) { var sub = _c[_i]; if (isSxTruthy(!isSxTruthy(contains(seen, sub)))) { { var _c = queue; for (var _i = 0; _i < _c.length; _i++) { var [Symbol('s'), Keyword('as'), Symbol('signal')] = _c[_i]; { var _c = signalSubscribers(s); for (var _i = 0; _i < _c.length; _i++) { var [Symbol('sub'), Keyword('as'), Symbol('lambda')] = _c[_i]; if (isSxTruthy(!isSxTruthy(contains(seen, sub)))) {
seen.push(sub); seen.push(sub);
pending.push(sub); pending.push(sub);
} } } } } } } } } }

80
shared/sx/ref/adapter-async.sx
View File

@@ -41,7 +41,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render (define-async async-render
(fn (expr env ctx) (fn (expr (env :as dict) ctx)
(case (type-of expr) (case (type-of expr)
"nil" "" "nil" ""
"boolean" "" "boolean" ""
@@ -57,7 +57,7 @@
(define-async async-render-list (define-async async-render-list
(fn (expr env ctx) (fn (expr (env :as dict) ctx)
(let ((head (first expr))) (let ((head (first expr)))
(if (not (= (type-of head) "symbol")) (if (not (= (type-of head) "symbol"))
;; Non-symbol head — data list, render each item ;; Non-symbol head — data list, render each item
@@ -139,7 +139,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render-raw (define-async async-render-raw
(fn (args env ctx) (fn ((args :as list) (env :as dict) ctx)
(let ((parts (list))) (let ((parts (list)))
(for-each (for-each
(fn (arg) (fn (arg)
@@ -158,7 +158,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render-element (define-async async-render-element
(fn (tag args env ctx) (fn ((tag :as string) (args :as list) (env :as dict) ctx)
(let ((attrs (dict)) (let ((attrs (dict))
(children (list))) (children (list)))
;; Parse keyword attrs and children ;; Parse keyword attrs and children
@@ -186,7 +186,7 @@
;; compiles inline for-each lambdas as for loops (which can contain await). ;; compiles inline for-each lambdas as for loops (which can contain await).
(define-async async-parse-element-args (define-async async-parse-element-args
(fn (args attrs children env ctx) (fn ((args :as list) (attrs :as dict) (children :as list) (env :as dict) ctx)
(let ((skip false) (let ((skip false)
(i 0)) (i 0))
(for-each (for-each
@@ -211,7 +211,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render-component (define-async async-render-component
(fn (comp args env ctx) (fn ((comp :as component) (args :as list) (env :as dict) ctx)
(let ((kwargs (dict)) (let ((kwargs (dict))
(children (list))) (children (list)))
;; Parse keyword args and children ;; Parse keyword args and children
@@ -233,7 +233,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render-island (define-async async-render-island
(fn (island args env ctx) (fn (island (args :as list) (env :as dict) ctx)
(let ((kwargs (dict)) (let ((kwargs (dict))
(children (list))) (children (list)))
(async-parse-kw-args args kwargs children env ctx) (async-parse-kw-args args kwargs children env ctx)
@@ -262,7 +262,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render-lambda (define-async async-render-lambda
(fn (f args env ctx) (fn ((f :as lambda) (args :as list) (env :as dict) ctx)
(let ((local (env-merge (lambda-closure f) env))) (let ((local (env-merge (lambda-closure f) env)))
(for-each-indexed (for-each-indexed
(fn (i p) (env-set! local p (nth args i))) (fn (i p) (env-set! local p (nth args i)))
@@ -275,7 +275,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-parse-kw-args (define-async async-parse-kw-args
(fn (args kwargs children env ctx) (fn ((args :as list) (kwargs :as dict) (children :as list) (env :as dict) ctx)
(let ((skip false) (let ((skip false)
(i 0)) (i 0))
(for-each (for-each
@@ -301,7 +301,7 @@
;; Bootstrapper emits this as: [await async_render(x, env, ctx) for x in exprs] ;; Bootstrapper emits this as: [await async_render(x, env, ctx) for x in exprs]
(define-async async-map-render (define-async async-map-render
(fn (exprs env ctx) (fn ((exprs :as list) (env :as dict) ctx)
(let ((results (list))) (let ((results (list)))
(for-each (for-each
(fn (x) (append! results (async-render x env ctx))) (fn (x) (append! results (async-render x env ctx)))
@@ -319,7 +319,7 @@
"map" "map-indexed" "filter" "for-each")) "map" "map-indexed" "filter" "for-each"))
(define async-render-form? (define async-render-form?
(fn (name) (fn ((name :as string))
(contains? ASYNC_RENDER_FORMS name))) (contains? ASYNC_RENDER_FORMS name)))
@@ -331,7 +331,7 @@
;; and eval-cond from render.sx for correct scheme/clojure classification. ;; and eval-cond from render.sx for correct scheme/clojure classification.
(define-async dispatch-async-render-form (define-async dispatch-async-render-form
(fn (name expr env ctx) (fn ((name :as string) expr (env :as dict) ctx)
(cond (cond
;; if ;; if
(= name "if") (= name "if")
@@ -407,7 +407,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render-cond-scheme (define-async async-render-cond-scheme
(fn (clauses env ctx) (fn ((clauses :as list) (env :as dict) ctx)
(if (empty? clauses) (if (empty? clauses)
"" ""
(let ((clause (first clauses)) (let ((clause (first clauses))
@@ -429,7 +429,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-render-cond-clojure (define-async async-render-cond-clojure
(fn (clauses env ctx) (fn ((clauses :as list) (env :as dict) ctx)
(if (< (len clauses) 2) (if (< (len clauses) 2)
"" ""
(let ((test (first clauses)) (let ((test (first clauses))
@@ -449,7 +449,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-process-bindings (define-async async-process-bindings
(fn (bindings env ctx) (fn (bindings (env :as dict) ctx)
;; env-extend (not merge) — Env is not a dict subclass, so merge() ;; env-extend (not merge) — Env is not a dict subclass, so merge()
;; returns an empty dict, losing all parent scope bindings. ;; returns an empty dict, losing all parent scope bindings.
(let ((local (env-extend env))) (let ((local (env-extend env)))
@@ -470,7 +470,7 @@
(define-async async-process-bindings-flat (define-async async-process-bindings-flat
(fn (bindings local ctx) (fn ((bindings :as list) (local :as dict) ctx)
(let ((skip false) (let ((skip false)
(i 0)) (i 0))
(for-each (for-each
@@ -495,7 +495,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-map-fn-render (define-async async-map-fn-render
(fn (f coll env ctx) (fn (f (coll :as list) (env :as dict) ctx)
(let ((results (list))) (let ((results (list)))
(for-each (for-each
(fn (item) (fn (item)
@@ -512,7 +512,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-map-indexed-fn-render (define-async async-map-indexed-fn-render
(fn (f coll env ctx) (fn (f (coll :as list) (env :as dict) ctx)
(let ((results (list)) (let ((results (list))
(i 0)) (i 0))
(for-each (for-each
@@ -543,7 +543,7 @@
;; ========================================================================== ;; ==========================================================================
(define-async async-aser (define-async async-aser
(fn (expr env ctx) (fn (expr (env :as dict) ctx)
(case (type-of expr) (case (type-of expr)
"number" expr "number" expr
"string" expr "string" expr
@@ -573,7 +573,7 @@
(define-async async-aser-dict (define-async async-aser-dict
(fn (expr env ctx) (fn ((expr :as dict) (env :as dict) ctx)
(let ((result (dict))) (let ((result (dict)))
(for-each (for-each
(fn (key) (fn (key)
@@ -587,7 +587,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-list (define-async async-aser-list
(fn (expr env ctx) (fn (expr (env :as dict) ctx)
(let ((head (first expr)) (let ((head (first expr))
(args (rest expr))) (args (rest expr)))
(if (not (= (type-of head) "symbol")) (if (not (= (type-of head) "symbol"))
@@ -666,7 +666,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-eval-call (define-async async-aser-eval-call
(fn (head args env ctx) (fn (head (args :as list) (env :as dict) ctx)
(let ((f (async-eval head env ctx)) (let ((f (async-eval head env ctx))
(evaled-args (async-eval-args args env ctx))) (evaled-args (async-eval-args args env ctx)))
(cond (cond
@@ -694,7 +694,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-eval-args (define-async async-eval-args
(fn (args env ctx) (fn ((args :as list) (env :as dict) ctx)
(let ((results (list))) (let ((results (list)))
(for-each (for-each
(fn (a) (append! results (async-eval a env ctx))) (fn (a) (append! results (async-eval a env ctx)))
@@ -707,7 +707,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-map-list (define-async async-aser-map-list
(fn (exprs env ctx) (fn ((exprs :as list) (env :as dict) ctx)
(let ((results (list))) (let ((results (list)))
(for-each (for-each
(fn (x) (append! results (async-aser x env ctx))) (fn (x) (append! results (async-aser x env ctx)))
@@ -720,7 +720,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-fragment (define-async async-aser-fragment
(fn (children env ctx) (fn ((children :as list) (env :as dict) ctx)
(let ((parts (list))) (let ((parts (list)))
(for-each (for-each
(fn (c) (fn (c)
@@ -744,7 +744,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-component (define-async async-aser-component
(fn (comp args env ctx) (fn ((comp :as component) (args :as list) (env :as dict) ctx)
(let ((kwargs (dict)) (let ((kwargs (dict))
(children (list))) (children (list)))
(async-parse-aser-kw-args args kwargs children env ctx) (async-parse-aser-kw-args args kwargs children env ctx)
@@ -776,7 +776,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-parse-aser-kw-args (define-async async-parse-aser-kw-args
(fn (args kwargs children env ctx) (fn ((args :as list) (kwargs :as dict) (children :as list) (env :as dict) ctx)
(let ((skip false) (let ((skip false)
(i 0)) (i 0))
(for-each (for-each
@@ -801,7 +801,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-call (define-async async-aser-call
(fn (name args env ctx) (fn ((name :as string) (args :as list) (env :as dict) ctx)
(let ((token (if (or (= name "svg") (= name "math")) (let ((token (if (or (= name "svg") (= name "math"))
(svg-context-set! true) (svg-context-set! true)
nil)) nil))
@@ -859,7 +859,7 @@
(list "map" "map-indexed" "filter" "for-each")) (list "map" "map-indexed" "filter" "for-each"))
(define async-aser-form? (define async-aser-form?
(fn (name) (fn ((name :as string))
(or (contains? ASYNC_ASER_FORM_NAMES name) (or (contains? ASYNC_ASER_FORM_NAMES name)
(contains? ASYNC_ASER_HO_NAMES name)))) (contains? ASYNC_ASER_HO_NAMES name))))
@@ -871,7 +871,7 @@
;; Uses cond-scheme? from eval.sx (the FIXED version with every? check). ;; Uses cond-scheme? from eval.sx (the FIXED version with every? check).
(define-async dispatch-async-aser-form (define-async dispatch-async-aser-form
(fn (name expr env ctx) (fn ((name :as string) expr (env :as dict) ctx)
(let ((args (rest expr))) (let ((args (rest expr)))
(cond (cond
;; if ;; if
@@ -1000,7 +1000,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-cond-scheme (define-async async-aser-cond-scheme
(fn (clauses env ctx) (fn ((clauses :as list) (env :as dict) ctx)
(if (empty? clauses) (if (empty? clauses)
nil nil
(let ((clause (first clauses)) (let ((clause (first clauses))
@@ -1022,7 +1022,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-cond-clojure (define-async async-aser-cond-clojure
(fn (clauses env ctx) (fn ((clauses :as list) (env :as dict) ctx)
(if (< (len clauses) 2) (if (< (len clauses) 2)
nil nil
(let ((test (first clauses)) (let ((test (first clauses))
@@ -1042,7 +1042,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-case-loop (define-async async-aser-case-loop
(fn (match-val clauses env ctx) (fn (match-val (clauses :as list) (env :as dict) ctx)
(if (< (len clauses) 2) (if (< (len clauses) 2)
nil nil
(let ((test (first clauses)) (let ((test (first clauses))
@@ -1062,7 +1062,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-thread-first (define-async async-aser-thread-first
(fn (args env ctx) (fn ((args :as list) (env :as dict) ctx)
(let ((result (async-eval (first args) env ctx))) (let ((result (async-eval (first args) env ctx)))
(for-each (for-each
(fn (form) (fn (form)
@@ -1082,7 +1082,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-invoke-or-lambda (define-async async-invoke-or-lambda
(fn (f args env ctx) (fn (f (args :as list) (env :as dict) ctx)
(cond (cond
(and (callable? f) (not (lambda? f)) (not (component? f))) (and (callable? f) (not (lambda? f)) (not (component? f)))
(let ((r (apply f args))) (let ((r (apply f args)))
@@ -1104,7 +1104,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define-async async-aser-ho-map (define-async async-aser-ho-map
(fn (args env ctx) (fn ((args :as list) (env :as dict) ctx)
(let ((f (async-eval (first args) env ctx)) (let ((f (async-eval (first args) env ctx))
(coll (async-eval (nth args 1) env ctx)) (coll (async-eval (nth args 1) env ctx))
(results (list))) (results (list)))
@@ -1120,7 +1120,7 @@
(define-async async-aser-ho-map-indexed (define-async async-aser-ho-map-indexed
(fn (args env ctx) (fn ((args :as list) (env :as dict) ctx)
(let ((f (async-eval (first args) env ctx)) (let ((f (async-eval (first args) env ctx))
(coll (async-eval (nth args 1) env ctx)) (coll (async-eval (nth args 1) env ctx))
(results (list)) (results (list))
@@ -1139,7 +1139,7 @@
(define-async async-aser-ho-for-each (define-async async-aser-ho-for-each
(fn (args env ctx) (fn ((args :as list) (env :as dict) ctx)
(let ((f (async-eval (first args) env ctx)) (let ((f (async-eval (first args) env ctx))
(coll (async-eval (nth args 1) env ctx)) (coll (async-eval (nth args 1) env ctx))
(results (list))) (results (list)))
@@ -1170,7 +1170,7 @@
;; (set-expand-components!) — enable component expansion context var ;; (set-expand-components!) — enable component expansion context var
(define-async async-eval-slot-inner (define-async async-eval-slot-inner
(fn (expr env ctx) (fn (expr (env :as dict) ctx)
;; NOTE: Uses statement-form let + set! to avoid expression-context ;; NOTE: Uses statement-form let + set! to avoid expression-context
;; let (IIFE lambdas) which can't contain await in Python. ;; let (IIFE lambdas) which can't contain await in Python.
(let ((result nil)) (let ((result nil))
@@ -1196,7 +1196,7 @@
(define-async async-maybe-expand-result (define-async async-maybe-expand-result
(fn (result env ctx) (fn (result (env :as dict) ctx)
;; If the aser result is a component call string like "(~foo ...)", ;; If the aser result is a component call string like "(~foo ...)",
;; re-parse and expand it. This handles indirect component references ;; re-parse and expand it. This handles indirect component references
;; (e.g. a let binding that evaluates to a component call). ;; (e.g. a let binding that evaluates to a component call).

40
shared/sx/ref/adapter-dom.sx
View File

@@ -19,7 +19,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-to-dom (define render-to-dom
(fn (expr env ns) (fn (expr (env :as dict) ns)
(set-render-active! true) (set-render-active! true)
(case (type-of expr) (case (type-of expr)
;; nil / boolean false / boolean true → empty fragment ;; nil / boolean false / boolean true → empty fragment
@@ -67,7 +67,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-dom-list (define render-dom-list
(fn (expr env ns) (fn (expr (env :as dict) ns)
(let ((head (first expr))) (let ((head (first expr)))
(cond (cond
;; Symbol head — dispatch on name ;; Symbol head — dispatch on name
@@ -166,7 +166,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-dom-element (define render-dom-element
(fn (tag args env ns) (fn ((tag :as string) (args :as list) (env :as dict) ns)
;; Detect namespace from tag ;; Detect namespace from tag
(let ((new-ns (cond (= tag "svg") SVG_NS (let ((new-ns (cond (= tag "svg") SVG_NS
(= tag "math") MATH_NS (= tag "math") MATH_NS
@@ -237,7 +237,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-dom-component (define render-dom-component
(fn (comp args env ns) (fn ((comp :as component) (args :as list) (env :as dict) ns)
;; Parse kwargs and children, bind into component env, render body. ;; Parse kwargs and children, bind into component env, render body.
(let ((kwargs (dict)) (let ((kwargs (dict))
(children (list))) (children (list)))
@@ -284,7 +284,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-dom-fragment (define render-dom-fragment
(fn (args env ns) (fn ((args :as list) (env :as dict) ns)
(let ((frag (create-fragment))) (let ((frag (create-fragment)))
(for-each (for-each
(fn (x) (dom-append frag (render-to-dom x env ns))) (fn (x) (dom-append frag (render-to-dom x env ns)))
@@ -297,7 +297,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-dom-raw (define render-dom-raw
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((frag (create-fragment))) (let ((frag (create-fragment)))
(for-each (for-each
(fn (arg) (fn (arg)
@@ -318,7 +318,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-dom-unknown-component (define render-dom-unknown-component
(fn (name) (fn ((name :as string))
(error (str "Unknown component: " name)))) (error (str "Unknown component: " name))))
@@ -335,11 +335,11 @@
"error-boundary")) "error-boundary"))
(define render-dom-form? (define render-dom-form?
(fn (name) (fn ((name :as string))
(contains? RENDER_DOM_FORMS name))) (contains? RENDER_DOM_FORMS name)))
(define dispatch-render-form (define dispatch-render-form
(fn (name expr env ns) (fn ((name :as string) expr (env :as dict) ns)
(cond (cond
;; if — reactive inside islands (re-renders when signal deps change) ;; if — reactive inside islands (re-renders when signal deps change)
(= name "if") (= name "if")
@@ -581,7 +581,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-lambda-dom (define render-lambda-dom
(fn (f args env ns) (fn ((f :as lambda) (args :as list) (env :as dict) ns)
;; Bind lambda params and render body as DOM ;; Bind lambda params and render body as DOM
(let ((local (env-merge (lambda-closure f) env))) (let ((local (env-merge (lambda-closure f) env)))
(for-each-indexed (for-each-indexed
@@ -605,7 +605,7 @@
;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide ;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide
(define render-dom-island (define render-dom-island
(fn (island args env ns) (fn (island (args :as list) (env :as dict) ns)
;; Parse kwargs and children (same as component) ;; Parse kwargs and children (same as component)
(let ((kwargs (dict)) (let ((kwargs (dict))
(children (list))) (children (list)))
@@ -679,7 +679,7 @@
;; Supports :tag keyword to change wrapper element (default "div"). ;; Supports :tag keyword to change wrapper element (default "div").
(define render-dom-lake (define render-dom-lake
(fn (args env ns) (fn ((args :as list) (env :as dict) ns)
(let ((lake-id nil) (let ((lake-id nil)
(lake-tag "div") (lake-tag "div")
(children (list))) (children (list)))
@@ -723,7 +723,7 @@
;; Stores the island env and transform on the element for morph retrieval. ;; Stores the island env and transform on the element for morph retrieval.
(define render-dom-marsh (define render-dom-marsh
(fn (args env ns) (fn ((args :as list) (env :as dict) ns)
(let ((marsh-id nil) (let ((marsh-id nil)
(marsh-tag "div") (marsh-tag "div")
(marsh-transform nil) (marsh-transform nil)
@@ -781,7 +781,7 @@
;; Marks the attribute name on the element via data-sx-reactive-attrs so ;; Marks the attribute name on the element via data-sx-reactive-attrs so
;; the morph algorithm knows not to overwrite it with server content. ;; the morph algorithm knows not to overwrite it with server content.
(define reactive-attr (define reactive-attr
(fn (el attr-name compute-fn) (fn (el (attr-name :as string) compute-fn)
;; Mark this attribute as reactively managed ;; Mark this attribute as reactively managed
(let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")) (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
(updated (if (empty? existing) attr-name (str existing "," attr-name)))) (updated (if (empty? existing) attr-name (str existing "," attr-name))))
@@ -802,7 +802,7 @@
;; reactive-fragment — conditionally render a fragment based on a signal ;; reactive-fragment — conditionally render a fragment based on a signal
;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island. ;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island.
(define reactive-fragment (define reactive-fragment
(fn (test-fn render-fn env ns) (fn (test-fn render-fn (env :as dict) ns)
(let ((marker (create-comment "island-fragment")) (let ((marker (create-comment "island-fragment"))
(current-nodes (list))) (current-nodes (list)))
(effect (fn () (effect (fn ()
@@ -824,13 +824,13 @@
;; and reorderings touch the DOM. Without keys, falls back to clear+rerender. ;; and reorderings touch the DOM. Without keys, falls back to clear+rerender.
(define render-list-item (define render-list-item
(fn (map-fn item env ns) (fn (map-fn item (env :as dict) ns)
(if (lambda? map-fn) (if (lambda? map-fn)
(render-lambda-dom map-fn (list item) env ns) (render-lambda-dom map-fn (list item) env ns)
(render-to-dom (apply map-fn (list item)) env ns)))) (render-to-dom (apply map-fn (list item)) env ns))))
(define extract-key (define extract-key
(fn (node index) (fn (node (index :as number))
;; Extract key from rendered node: :key attr, data-key, or index fallback ;; Extract key from rendered node: :key attr, data-key, or index fallback
(let ((k (dom-get-attr node "key"))) (let ((k (dom-get-attr node "key")))
(if k (if k
@@ -839,7 +839,7 @@
(if dk (str dk) (str "__idx_" index))))))) (if dk (str dk) (str "__idx_" index)))))))
(define reactive-list (define reactive-list
(fn (map-fn items-sig env ns) (fn (map-fn items-sig (env :as dict) ns)
(let ((container (create-fragment)) (let ((container (create-fragment))
(marker (create-comment "island-list")) (marker (create-comment "island-list"))
(key-map (dict)) (key-map (dict))
@@ -960,7 +960,7 @@
;; teardown. ;; teardown.
(define render-dom-portal (define render-dom-portal
(fn (args env ns) (fn ((args :as list) (env :as dict) ns)
(let ((selector (trampoline (eval-expr (first args) env))) (let ((selector (trampoline (eval-expr (first args) env)))
(target (or (dom-query selector) (target (or (dom-query selector)
(dom-ensure-element selector)))) (dom-ensure-element selector))))
@@ -1000,7 +1000,7 @@
;; Calling (retry) re-renders the body, replacing the fallback. ;; Calling (retry) re-renders the body, replacing the fallback.
(define render-dom-error-boundary (define render-dom-error-boundary
(fn (args env ns) (fn ((args :as list) (env :as dict) ns)
(let ((fallback-expr (first args)) (let ((fallback-expr (first args))
(body-exprs (rest args)) (body-exprs (rest args))
(container (dom-create-element "div" nil)) (container (dom-create-element "div" nil))

24
shared/sx/ref/adapter-html.sx
View File

@@ -14,7 +14,7 @@
(define render-to-html (define render-to-html
(fn (expr env) (fn (expr (env :as dict))
(set-render-active! true) (set-render-active! true)
(case (type-of expr) (case (type-of expr)
;; Literals — render directly ;; Literals — render directly
@@ -34,7 +34,7 @@
:else (render-value-to-html (trampoline (eval-expr expr env)) env)))) :else (render-value-to-html (trampoline (eval-expr expr env)) env))))
(define render-value-to-html (define render-value-to-html
(fn (val env) (fn (val (env :as dict))
(case (type-of val) (case (type-of val)
"nil" "" "nil" ""
"string" (escape-html val) "string" (escape-html val)
@@ -55,7 +55,7 @@
"map" "map-indexed" "filter" "for-each")) "map" "map-indexed" "filter" "for-each"))
(define render-html-form? (define render-html-form?
(fn (name) (fn ((name :as string))
(contains? RENDER_HTML_FORMS name))) (contains? RENDER_HTML_FORMS name)))
@@ -64,7 +64,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-list-to-html (define render-list-to-html
(fn (expr env) (fn ((expr :as list) (env :as dict))
(if (empty? expr) (if (empty? expr)
"" ""
(let ((head (first expr))) (let ((head (first expr)))
@@ -135,7 +135,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define dispatch-html-form (define dispatch-html-form
(fn (name expr env) (fn ((name :as string) (expr :as list) (env :as dict))
(cond (cond
;; if ;; if
(= name "if") (= name "if")
@@ -235,7 +235,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-lambda-html (define render-lambda-html
(fn (f args env) (fn ((f :as lambda) (args :as list) (env :as dict))
(let ((local (env-merge (lambda-closure f) env))) (let ((local (env-merge (lambda-closure f) env)))
(for-each-indexed (for-each-indexed
(fn (i p) (fn (i p)
@@ -249,7 +249,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define render-html-component (define render-html-component
(fn (comp args env) (fn ((comp :as component) (args :as list) (env :as dict))
;; Expand component and render body through HTML adapter. ;; Expand component and render body through HTML adapter.
;; Component body contains rendering forms (HTML tags) that only the ;; Component body contains rendering forms (HTML tags) that only the
;; adapter understands, so expansion must happen here, not in eval-expr. ;; adapter understands, so expansion must happen here, not in eval-expr.
@@ -288,7 +288,7 @@
(define render-html-element (define render-html-element
(fn (tag args env) (fn ((tag :as string) (args :as list) (env :as dict))
(let ((parsed (parse-element-args args env)) (let ((parsed (parse-element-args args env))
(attrs (first parsed)) (attrs (first parsed))
(children (nth parsed 1)) (children (nth parsed 1))
@@ -312,7 +312,7 @@
;; content while preserving surrounding reactive DOM. ;; content while preserving surrounding reactive DOM.
(define render-html-lake (define render-html-lake
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((lake-id nil) (let ((lake-id nil)
(lake-tag "div") (lake-tag "div")
(children (list))) (children (list)))
@@ -351,7 +351,7 @@
;; the :transform is a client-only concern. ;; the :transform is a client-only concern.
(define render-html-marsh (define render-html-marsh
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((marsh-id nil) (let ((marsh-id nil)
(marsh-tag "div") (marsh-tag "div")
(children (list))) (children (list)))
@@ -394,7 +394,7 @@
;; (swap! s f) → no-op ;; (swap! s f) → no-op
(define render-html-island (define render-html-island
(fn (island args env) (fn ((island :as island) (args :as list) (env :as dict))
;; Parse kwargs and children (same pattern as render-html-component) ;; Parse kwargs and children (same pattern as render-html-component)
(let ((kwargs (dict)) (let ((kwargs (dict))
(children (list))) (children (list)))
@@ -452,7 +452,7 @@
;; Handles all SX types natively: numbers, strings, booleans, nil, lists, dicts. ;; Handles all SX types natively: numbers, strings, booleans, nil, lists, dicts.
(define serialize-island-state (define serialize-island-state
(fn (kwargs) (fn ((kwargs :as dict))
(if (empty-dict? kwargs) (if (empty-dict? kwargs)
nil nil
(sx-serialize kwargs)))) (sx-serialize kwargs))))

18
shared/sx/ref/adapter-sx.sx
View File

@@ -12,7 +12,7 @@
(define render-to-sx (define render-to-sx
(fn (expr env) (fn (expr (env :as dict))
(let ((result (aser expr env))) (let ((result (aser expr env)))
;; aser-call already returns serialized SX strings; ;; aser-call already returns serialized SX strings;
;; only serialize non-string values ;; only serialize non-string values
@@ -21,7 +21,7 @@
(serialize result))))) (serialize result)))))
(define aser (define aser
(fn (expr env) (fn (expr (env :as dict))
;; Evaluate for SX wire format — serialize rendering forms, ;; Evaluate for SX wire format — serialize rendering forms,
;; evaluate control flow and function calls. ;; evaluate control flow and function calls.
(set-render-active! true) (set-render-active! true)
@@ -52,7 +52,7 @@
(define aser-list (define aser-list
(fn (expr env) (fn ((expr :as list) (env :as dict))
(let ((head (first expr)) (let ((head (first expr))
(args (rest expr))) (args (rest expr)))
(if (not (= (type-of head) "symbol")) (if (not (= (type-of head) "symbol"))
@@ -104,7 +104,7 @@
(define aser-fragment (define aser-fragment
(fn (children env) (fn ((children :as list) (env :as dict))
;; Serialize (<> child1 child2 ...) to sx source string ;; Serialize (<> child1 child2 ...) to sx source string
;; Must flatten list results (e.g. from map/filter) to avoid nested parens ;; Must flatten list results (e.g. from map/filter) to avoid nested parens
(let ((parts (list))) (let ((parts (list)))
@@ -126,7 +126,7 @@
(define aser-call (define aser-call
(fn (name args env) (fn ((name :as string) (args :as list) (env :as dict))
;; Serialize (name :key val child ...) — evaluate args but keep as sx ;; Serialize (name :key val child ...) — evaluate args but keep as sx
;; Uses for-each + mutable state (not reduce) so bootstrapper emits for-loops ;; Uses for-each + mutable state (not reduce) so bootstrapper emits for-loops
;; that can contain nested for-each for list flattening. ;; that can contain nested for-each for list flattening.
@@ -177,11 +177,11 @@
"some" "every?" "for-each")) "some" "every?" "for-each"))
(define special-form? (define special-form?
(fn (name) (fn ((name :as string))
(contains? SPECIAL_FORM_NAMES name))) (contains? SPECIAL_FORM_NAMES name)))
(define ho-form? (define ho-form?
(fn (name) (fn ((name :as string))
(contains? HO_FORM_NAMES name))) (contains? HO_FORM_NAMES name)))
@@ -194,7 +194,7 @@
;; Definition forms evaluate for side effects and return nil. ;; Definition forms evaluate for side effects and return nil.
(define aser-special (define aser-special
(fn (name expr env) (fn ((name :as string) (expr :as list) (env :as dict))
(let ((args (rest expr))) (let ((args (rest expr)))
(cond (cond
;; if — evaluate condition, aser chosen branch ;; if — evaluate condition, aser chosen branch
@@ -314,7 +314,7 @@
;; Helper: case dispatch for aser mode ;; Helper: case dispatch for aser mode
(define eval-case-aser (define eval-case-aser
(fn (match-val clauses env) (fn (match-val (clauses :as list) (env :as dict))
(if (< (len clauses) 2) (if (< (len clauses) 2)
nil nil
(let ((test (first clauses)) (let ((test (first clauses))

16
shared/sx/ref/boot.sx
View File

@@ -72,7 +72,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sx-mount (define sx-mount
(fn (target source extra-env) (fn (target (source :as string) (extra-env :as dict))
;; Render SX source string into target element. ;; Render SX source string into target element.
;; target: Element or CSS selector string ;; target: Element or CSS selector string
;; source: SX source string ;; source: SX source string
@@ -101,7 +101,7 @@
;; new SX content, and replaces the wrapper's children. ;; new SX content, and replaces the wrapper's children.
(define resolve-suspense (define resolve-suspense
(fn (id sx) (fn ((id :as string) (sx :as string))
;; Process any new <script type="text/sx"> tags that arrived via ;; Process any new <script type="text/sx"> tags that arrived via
;; streaming (e.g. extra component defs) before resolving. ;; streaming (e.g. extra component defs) before resolving.
(process-sx-scripts nil) (process-sx-scripts nil)
@@ -166,7 +166,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sx-render-component (define sx-render-component
(fn (name kwargs extra-env) (fn ((name :as string) (kwargs :as dict) (extra-env :as dict))
;; Render a named component with keyword args. ;; Render a named component with keyword args.
;; name: component name (with or without ~ prefix) ;; name: component name (with or without ~ prefix)
;; kwargs: dict of param-name → value ;; kwargs: dict of param-name → value
@@ -179,7 +179,7 @@
;; Build synthetic call expression ;; Build synthetic call expression
(let ((call-expr (list (make-symbol full-name)))) (let ((call-expr (list (make-symbol full-name))))
(for-each (for-each
(fn (k) (fn ((k :as string))
(append! call-expr (make-keyword (to-kebab k))) (append! call-expr (make-keyword (to-kebab k)))
(append! call-expr (dict-get kwargs k))) (append! call-expr (dict-get kwargs k)))
(keys kwargs)) (keys kwargs))
@@ -236,7 +236,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define process-component-script (define process-component-script
(fn (script text) (fn (script (text :as string))
;; Handle <script type="text/sx" data-components data-hash="..."> ;; Handle <script type="text/sx" data-components data-hash="...">
(let ((hash (dom-get-attr script "data-hash"))) (let ((hash (dom-get-attr script "data-hash")))
(if (nil? hash) (if (nil? hash)
@@ -304,7 +304,7 @@
(let ((pages (parse text))) (let ((pages (parse text)))
(log-info (str "pages: parsed " (len pages) " entries")) (log-info (str "pages: parsed " (len pages) " entries"))
(for-each (for-each
(fn (page) (fn ((page :as dict))
(append! _page-routes (append! _page-routes
(merge page (merge page
{"parsed" (parse-route-pattern (get page "path"))}))) {"parsed" (parse-route-pattern (get page "path"))})))
@@ -358,7 +358,7 @@
;; Bind params from kwargs ;; Bind params from kwargs
(for-each (for-each
(fn (p) (fn ((p :as string))
(env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params comp)) (component-params comp))
@@ -393,7 +393,7 @@
(let ((disposers (dom-get-data el "sx-disposers"))) (let ((disposers (dom-get-data el "sx-disposers")))
(when disposers (when disposers
(for-each (for-each
(fn (d) (fn ((d :as lambda))
(when (callable? d) (d))) (when (callable? d) (d)))
disposers) disposers)
(dom-set-data el "sx-disposers" nil))))) (dom-set-data el "sx-disposers" nil)))))

25
shared/sx/ref/bootstrap_py.py
View File

@@ -442,6 +442,15 @@ class PyEmitter:
# --- Special form emitters --- # --- Special form emitters ---
@staticmethod
def _extract_param_name(p):
"""Extract the name from a param, handling (name :as type) annotations."""
if isinstance(p, list) and len(p) == 3 and isinstance(p[1], Keyword) and p[1].name == "as":
return p[0].name if isinstance(p[0], Symbol) else str(p[0])
if isinstance(p, Symbol):
return p.name
return str(p)
def _emit_fn(self, expr) -> str: def _emit_fn(self, expr) -> str:
params = expr[1] params = expr[1]
body = expr[2:] body = expr[2:]
@@ -453,16 +462,13 @@ class PyEmitter:
if isinstance(p, Symbol) and p.name == "&rest": if isinstance(p, Symbol) and p.name == "&rest":
# Next param is the rest parameter # Next param is the rest parameter
if i + 1 < len(params): if i + 1 < len(params):
rest_name = self._mangle(params[i + 1].name if isinstance(params[i + 1], Symbol) else str(params[i + 1])) rest_name = self._mangle(self._extract_param_name(params[i + 1]))
i += 2 i += 2
continue continue
else: else:
i += 1 i += 1
continue continue
if isinstance(p, Symbol): param_names.append(self._mangle(self._extract_param_name(p)))
param_names.append(self._mangle(p.name))
else:
param_names.append(str(p))
i += 1 i += 1
if rest_name: if rest_name:
param_names.append(f"*{rest_name}") param_names.append(f"*{rest_name}")
@@ -708,17 +714,14 @@ class PyEmitter:
p = params[i] p = params[i]
if isinstance(p, Symbol) and p.name == "&rest": if isinstance(p, Symbol) and p.name == "&rest":
if i + 1 < len(params): if i + 1 < len(params):
rest_name = self._mangle(params[i + 1].name if isinstance(params[i + 1], Symbol) else str(params[i + 1])) rest_name = self._mangle(self._extract_param_name(params[i + 1]))
param_names.append(f"*{rest_name}") param_names.append(f"*{rest_name}")
i += 2 i += 2
continue continue
else: else:
i += 1 i += 1
continue continue
if isinstance(p, Symbol): param_names.append(self._mangle(self._extract_param_name(p)))
param_names.append(self._mangle(p.name))
else:
param_names.append(str(p))
i += 1 i += 1
params_str = ", ".join(param_names) params_str = ", ".join(param_names)
py_name = self._mangle(name) py_name = self._mangle(name)
@@ -956,7 +959,7 @@ class PyEmitter:
if isinstance(fn_expr, list) and isinstance(fn_expr[0], Symbol) and fn_expr[0].name == "fn": if isinstance(fn_expr, list) and isinstance(fn_expr[0], Symbol) and fn_expr[0].name == "fn":
params = fn_expr[1] params = fn_expr[1]
body = fn_expr[2:] body = fn_expr[2:]
p = params[0].name if isinstance(params[0], Symbol) else str(params[0]) p = self._extract_param_name(params[0])
p_py = self._mangle(p) p_py = self._mangle(p)
lines = [f"{pad}for {p_py} in {coll}:"] lines = [f"{pad}for {p_py} in {coll}:"]
# Emit body as statements with proper let/set! handling # Emit body as statements with proper let/set! handling

4
shared/sx/ref/continuations.sx
View File

@@ -82,7 +82,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-reset (define sf-reset
(fn (args env) (fn ((args :as list) (env :as dict))
;; Single argument: the body expression. ;; Single argument: the body expression.
;; Install a continuation delimiter, then evaluate body. ;; Install a continuation delimiter, then evaluate body.
;; The implementation is target-specific: ;; The implementation is target-specific:
@@ -136,7 +136,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-shift (define sf-shift
(fn (args env) (fn ((args :as list) (env :as dict))
;; Two arguments: the continuation variable name, and the body. ;; Two arguments: the continuation variable name, and the body.
(let ((k-name (symbol-name (first args))) (let ((k-name (symbol-name (first args)))
(body (second args))) (body (second args)))

72
shared/sx/ref/deps.sx
View File

@@ -39,7 +39,7 @@
(define scan-refs-walk (define scan-refs-walk
(fn (node refs) (fn (node (refs :as list))
(cond (cond
;; Symbol starting with ~ → component reference ;; Symbol starting with ~ → component reference
(= (type-of node) "symbol") (= (type-of node) "symbol")
@@ -68,26 +68,26 @@
;; that it can transitively render. Handles cycles via seen-set. ;; that it can transitively render. Handles cycles via seen-set.
(define transitive-deps-walk (define transitive-deps-walk
(fn (n seen env) (fn ((n :as string) (seen :as list) (env :as dict))
(when (not (contains? seen n)) (when (not (contains? seen n))
(append! seen n) (append! seen n)
(let ((val (env-get env n))) (let ((val (env-get env n)))
(cond (cond
(= (type-of val) "component") (= (type-of val) "component")
(for-each (fn (ref) (transitive-deps-walk ref seen env)) (for-each (fn ((ref :as string)) (transitive-deps-walk ref seen env))
(scan-refs (component-body val))) (scan-refs (component-body val)))
(= (type-of val) "macro") (= (type-of val) "macro")
(for-each (fn (ref) (transitive-deps-walk ref seen env)) (for-each (fn ((ref :as string)) (transitive-deps-walk ref seen env))
(scan-refs (macro-body val))) (scan-refs (macro-body val)))
:else nil))))) :else nil)))))
(define transitive-deps (define transitive-deps
(fn (name env) (fn ((name :as string) (env :as dict))
(let ((seen (list)) (let ((seen (list))
(key (if (starts-with? name "~") name (str "~" name)))) (key (if (starts-with? name "~") name (str "~" name))))
(transitive-deps-walk key seen env) (transitive-deps-walk key seen env)
(filter (fn (x) (not (= x key))) seen)))) (filter (fn ((x :as string)) (not (= x key))) seen))))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
@@ -101,9 +101,9 @@
;; (component-set-deps! comp deps) → store deps on component ;; (component-set-deps! comp deps) → store deps on component
(define compute-all-deps (define compute-all-deps
(fn (env) (fn ((env :as dict))
(for-each (for-each
(fn (name) (fn ((name :as string))
(let ((val (env-get env name))) (let ((val (env-get env name)))
(when (= (type-of val) "component") (when (= (type-of val) "component")
(component-set-deps! val (transitive-deps name env))))) (component-set-deps! val (transitive-deps name env)))))
@@ -120,9 +120,9 @@
;; (regex-find-all pattern source) → list of matched group strings ;; (regex-find-all pattern source) → list of matched group strings
(define scan-components-from-source (define scan-components-from-source
(fn (source) (fn ((source :as string))
(let ((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-]*)" source))) (let ((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-]*)" source)))
(map (fn (m) (str "~" m)) matches)))) (map (fn ((m :as string)) (str "~" m)) matches))))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
@@ -132,13 +132,13 @@
;; the transitive closure. Returns list of ~names. ;; the transitive closure. Returns list of ~names.
(define components-needed (define components-needed
(fn (page-source env) (fn ((page-source :as string) (env :as dict))
(let ((direct (scan-components-from-source page-source)) (let ((direct (scan-components-from-source page-source))
(all-needed (list))) (all-needed (list)))
;; Add each direct ref + its transitive deps ;; Add each direct ref + its transitive deps
(for-each (for-each
(fn (name) (fn ((name :as string))
(when (not (contains? all-needed name)) (when (not (contains? all-needed name))
(append! all-needed name)) (append! all-needed name))
(let ((val (env-get env name))) (let ((val (env-get env name)))
@@ -147,7 +147,7 @@
(component-deps val) (component-deps val)
(transitive-deps name env)))) (transitive-deps name env))))
(for-each (for-each
(fn (dep) (fn ((dep :as string))
(when (not (contains? all-needed dep)) (when (not (contains? all-needed dep))
(append! all-needed dep))) (append! all-needed dep)))
deps)))) deps))))
@@ -166,7 +166,7 @@
;; This replaces the "send everything" approach with per-page bundles. ;; This replaces the "send everything" approach with per-page bundles.
(define page-component-bundle (define page-component-bundle
(fn (page-source env) (fn ((page-source :as string) (env :as dict))
(components-needed page-source env))) (components-needed page-source env)))
@@ -181,17 +181,17 @@
;; (scan-css-classes source) → set/list of class strings from source ;; (scan-css-classes source) → set/list of class strings from source
(define page-css-classes (define page-css-classes
(fn (page-source env) (fn ((page-source :as string) (env :as dict))
(let ((needed (components-needed page-source env)) (let ((needed (components-needed page-source env))
(classes (list))) (classes (list)))
;; Collect classes from needed components ;; Collect classes from needed components
(for-each (for-each
(fn (name) (fn ((name :as string))
(let ((val (env-get env name))) (let ((val (env-get env name)))
(when (= (type-of val) "component") (when (= (type-of val) "component")
(for-each (for-each
(fn (cls) (fn ((cls :as string))
(when (not (contains? classes cls)) (when (not (contains? classes cls))
(append! classes cls))) (append! classes cls)))
(component-css-classes val))))) (component-css-classes val)))))
@@ -199,7 +199,7 @@
;; Add classes from page source ;; Add classes from page source
(for-each (for-each
(fn (cls) (fn ((cls :as string))
(when (not (contains? classes cls)) (when (not (contains? classes cls))
(append! classes cls))) (append! classes cls)))
(scan-css-classes page-source)) (scan-css-classes page-source))
@@ -219,7 +219,7 @@
;; (component-set-io-refs! c r) → cache IO refs on component ;; (component-set-io-refs! c r) → cache IO refs on component
(define scan-io-refs-walk (define scan-io-refs-walk
(fn (node io-names refs) (fn (node (io-names :as list) (refs :as list))
(cond (cond
;; Symbol → check if name is in the IO set ;; Symbol → check if name is in the IO set
(= (type-of node) "symbol") (= (type-of node) "symbol")
@@ -242,7 +242,7 @@
(define scan-io-refs (define scan-io-refs
(fn (node io-names) (fn (node (io-names :as list))
(let ((refs (list))) (let ((refs (list)))
(scan-io-refs-walk node io-names refs) (scan-io-refs-walk node io-names refs)
refs))) refs)))
@@ -253,7 +253,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define transitive-io-refs-walk (define transitive-io-refs-walk
(fn (n seen all-refs env io-names) (fn ((n :as string) (seen :as list) (all-refs :as list) (env :as dict) (io-names :as list))
(when (not (contains? seen n)) (when (not (contains? seen n))
(append! seen n) (append! seen n)
(let ((val (env-get env n))) (let ((val (env-get env n)))
@@ -262,31 +262,31 @@
(do (do
;; Scan this component's body for IO refs ;; Scan this component's body for IO refs
(for-each (for-each
(fn (ref) (fn ((ref :as string))
(when (not (contains? all-refs ref)) (when (not (contains? all-refs ref))
(append! all-refs ref))) (append! all-refs ref)))
(scan-io-refs (component-body val) io-names)) (scan-io-refs (component-body val) io-names))
;; Recurse into component deps ;; Recurse into component deps
(for-each (for-each
(fn (dep) (transitive-io-refs-walk dep seen all-refs env io-names)) (fn ((dep :as string)) (transitive-io-refs-walk dep seen all-refs env io-names))
(scan-refs (component-body val)))) (scan-refs (component-body val))))
(= (type-of val) "macro") (= (type-of val) "macro")
(do (do
(for-each (for-each
(fn (ref) (fn ((ref :as string))
(when (not (contains? all-refs ref)) (when (not (contains? all-refs ref))
(append! all-refs ref))) (append! all-refs ref)))
(scan-io-refs (macro-body val) io-names)) (scan-io-refs (macro-body val) io-names))
(for-each (for-each
(fn (dep) (transitive-io-refs-walk dep seen all-refs env io-names)) (fn ((dep :as string)) (transitive-io-refs-walk dep seen all-refs env io-names))
(scan-refs (macro-body val)))) (scan-refs (macro-body val))))
:else nil))))) :else nil)))))
(define transitive-io-refs (define transitive-io-refs
(fn (name env io-names) (fn ((name :as string) (env :as dict) (io-names :as list))
(let ((all-refs (list)) (let ((all-refs (list))
(seen (list)) (seen (list))
(key (if (starts-with? name "~") name (str "~" name)))) (key (if (starts-with? name "~") name (str "~" name))))
@@ -299,9 +299,9 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define compute-all-io-refs (define compute-all-io-refs
(fn (env io-names) (fn ((env :as dict) (io-names :as list))
(for-each (for-each
(fn (name) (fn ((name :as string))
(let ((val (env-get env name))) (let ((val (env-get env name)))
(when (= (type-of val) "component") (when (= (type-of val) "component")
(component-set-io-refs! val (transitive-io-refs name env io-names))))) (component-set-io-refs! val (transitive-io-refs name env io-names)))))
@@ -309,7 +309,7 @@
(define component-io-refs-cached (define component-io-refs-cached
(fn (name env io-names) (fn ((name :as string) (env :as dict) (io-names :as list))
(let ((key (if (starts-with? name "~") name (str "~" name)))) (let ((key (if (starts-with? name "~") name (str "~" name))))
(let ((val (env-get env key))) (let ((val (env-get env key)))
(if (and (= (type-of val) "component") (if (and (= (type-of val) "component")
@@ -320,7 +320,7 @@
(transitive-io-refs name env io-names)))))) (transitive-io-refs name env io-names))))))
(define component-pure? (define component-pure?
(fn (name env io-names) (fn ((name :as string) (env :as dict) (io-names :as list))
(let ((key (if (starts-with? name "~") name (str "~" name)))) (let ((key (if (starts-with? name "~") name (str "~" name))))
(let ((val (env-get env key))) (let ((val (env-get env key)))
(if (and (= (type-of val) "component") (if (and (= (type-of val) "component")
@@ -344,7 +344,7 @@
;; Returns: "server" | "client" ;; Returns: "server" | "client"
(define render-target (define render-target
(fn (name env io-names) (fn ((name :as string) (env :as dict) (io-names :as list))
(let ((key (if (starts-with? name "~") name (str "~" name)))) (let ((key (if (starts-with? name "~") name (str "~" name))))
(let ((val (env-get env key))) (let ((val (env-get env key)))
(if (not (= (type-of val) "component")) (if (not (= (type-of val) "component"))
@@ -373,7 +373,7 @@
;; without recomputing at every request. ;; without recomputing at every request.
(define page-render-plan (define page-render-plan
(fn (page-source env io-names) (fn ((page-source :as string) (env :as dict) (io-names :as list))
(let ((needed (components-needed page-source env)) (let ((needed (components-needed page-source env))
(comp-targets (dict)) (comp-targets (dict))
(server-list (list)) (server-list (list))
@@ -381,7 +381,7 @@
(io-deps (list))) (io-deps (list)))
(for-each (for-each
(fn (name) (fn ((name :as string))
(let ((target (render-target name env io-names))) (let ((target (render-target name env io-names)))
(dict-set! comp-targets name target) (dict-set! comp-targets name target)
(if (= target "server") (if (= target "server")
@@ -389,7 +389,7 @@
(append! server-list name) (append! server-list name)
;; Collect IO deps from server components (use cache) ;; Collect IO deps from server components (use cache)
(for-each (for-each
(fn (io-ref) (fn ((io-ref :as string))
(when (not (contains? io-deps io-ref)) (when (not (contains? io-deps io-ref))
(append! io-deps io-ref))) (append! io-deps io-ref)))
(component-io-refs-cached name env io-names))) (component-io-refs-cached name env io-names)))
@@ -451,9 +451,9 @@
;; Moved from platform to spec: pure logic using type predicates. ;; Moved from platform to spec: pure logic using type predicates.
(define env-components (define env-components
(fn (env) (fn ((env :as dict))
(filter (filter
(fn (k) (fn ((k :as string))
(let ((v (env-get env k))) (let ((v (env-get env k)))
(or (component? v) (macro? v)))) (or (component? v) (macro? v))))
(keys env)))) (keys env))))

54
shared/sx/ref/engine.sx
View File

@@ -32,7 +32,7 @@
;; Each descriptor is a dict with "event" and "modifiers" keys. ;; Each descriptor is a dict with "event" and "modifiers" keys.
(define parse-time (define parse-time
(fn (s) (fn ((s :as string))
;; Parse time string: "2s" → 2000, "500ms" → 500 ;; Parse time string: "2s" → 2000, "500ms" → 500
;; Uses nested if (not cond) because cond misclassifies 2-element ;; Uses nested if (not cond) because cond misclassifies 2-element
;; function calls like (nil? s) as scheme-style ((test body)) clauses. ;; function calls like (nil? s) as scheme-style ((test body)) clauses.
@@ -43,7 +43,7 @@
(define parse-trigger-spec (define parse-trigger-spec
(fn (spec) (fn ((spec :as string))
;; Parse "click delay:500ms once,change" → list of trigger descriptors ;; Parse "click delay:500ms once,change" → list of trigger descriptors
(if (nil? spec) (if (nil? spec)
nil nil
@@ -51,7 +51,7 @@
(filter (filter
(fn (x) (not (nil? x))) (fn (x) (not (nil? x)))
(map (map
(fn (part) (fn ((part :as string))
(let ((tokens (split (trim part) " "))) (let ((tokens (split (trim part) " ")))
(if (empty? tokens) (if (empty? tokens)
nil nil
@@ -63,7 +63,7 @@
;; Normal trigger with optional modifiers ;; Normal trigger with optional modifiers
(let ((mods (dict))) (let ((mods (dict)))
(for-each (for-each
(fn (tok) (fn ((tok :as string))
(cond (cond
(= tok "once") (= tok "once")
(dict-set! mods "once" true) (dict-set! mods "once" true)
@@ -81,7 +81,7 @@
(define default-trigger (define default-trigger
(fn (tag-name) (fn ((tag-name :as string))
;; Default trigger for element type ;; Default trigger for element type
(cond (cond
(= tag-name "FORM") (= tag-name "FORM")
@@ -102,7 +102,7 @@
(fn (el) (fn (el)
;; Check element for sx-get, sx-post, etc. Returns (dict "method" "url") or nil. ;; Check element for sx-get, sx-post, etc. Returns (dict "method" "url") or nil.
(some (some
(fn (verb) (fn ((verb :as string))
(let ((url (dom-get-attr el (str "sx-" verb)))) (let ((url (dom-get-attr el (str "sx-" verb))))
(if url (if url
(dict "method" (upper verb) "url" url) (dict "method" (upper verb) "url" url)
@@ -115,7 +115,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define build-request-headers (define build-request-headers
(fn (el loaded-components css-hash) (fn (el (loaded-components :as list) (css-hash :as string))
;; Build the SX request headers dict ;; Build the SX request headers dict
(let ((headers (dict (let ((headers (dict
"SX-Request" "true" "SX-Request" "true"
@@ -140,7 +140,7 @@
(let ((parsed (parse-header-value extra-h))) (let ((parsed (parse-header-value extra-h)))
(when parsed (when parsed
(for-each (for-each
(fn (key) (dict-set! headers key (str (get parsed key)))) (fn ((key :as string)) (dict-set! headers key (str (get parsed key))))
(keys parsed)))))) (keys parsed))))))
headers))) headers)))
@@ -175,13 +175,13 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define parse-swap-spec (define parse-swap-spec
(fn (raw-swap global-transitions?) (fn ((raw-swap :as string) (global-transitions? :as boolean))
;; Parse "innerHTML transition:true" → dict with style + transition flag ;; Parse "innerHTML transition:true" → dict with style + transition flag
(let ((parts (split (or raw-swap DEFAULT_SWAP) " ")) (let ((parts (split (or raw-swap DEFAULT_SWAP) " "))
(style (first parts)) (style (first parts))
(use-transition global-transitions?)) (use-transition global-transitions?))
(for-each (for-each
(fn (p) (fn ((p :as string))
(cond (cond
(= p "transition:true") (set! use-transition true) (= p "transition:true") (set! use-transition true)
(= p "transition:false") (set! use-transition false))) (= p "transition:false") (set! use-transition false)))
@@ -194,7 +194,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define parse-retry-spec (define parse-retry-spec
(fn (retry-attr) (fn ((retry-attr :as string))
;; Parse "exponential:1000:30000" → spec dict or nil ;; Parse "exponential:1000:30000" → spec dict or nil
(if (nil? retry-attr) (if (nil? retry-attr)
nil nil
@@ -206,7 +206,7 @@
(define next-retry-ms (define next-retry-ms
(fn (current-ms cap-ms) (fn ((current-ms :as number) (cap-ms :as number))
;; Exponential backoff: double current, cap at max ;; Exponential backoff: double current, cap at max
(min (* current-ms 2) cap-ms))) (min (* current-ms 2) cap-ms)))
@@ -216,7 +216,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define filter-params (define filter-params
(fn (params-spec all-params) (fn ((params-spec :as string) (all-params :as list))
;; Filter form parameters by sx-params spec. ;; Filter form parameters by sx-params spec.
;; all-params is a list of (key value) pairs. ;; all-params is a list of (key value) pairs.
;; Returns filtered list of (key value) pairs. ;; Returns filtered list of (key value) pairs.
@@ -227,11 +227,11 @@
(if (starts-with? params-spec "not ") (if (starts-with? params-spec "not ")
(let ((excluded (map trim (split (slice params-spec 4) ",")))) (let ((excluded (map trim (split (slice params-spec 4) ","))))
(filter (filter
(fn (p) (not (contains? excluded (first p)))) (fn ((p :as list)) (not (contains? excluded (first p))))
all-params)) all-params))
(let ((allowed (map trim (split params-spec ",")))) (let ((allowed (map trim (split params-spec ","))))
(filter (filter
(fn (p) (contains? allowed (first p))) (fn ((p :as list)) (contains? allowed (first p)))
all-params)))))))) all-params))))))))
@@ -279,7 +279,7 @@
(define revert-optimistic (define revert-optimistic
(fn (state) (fn ((state :as dict))
;; Revert an optimistic update ;; Revert an optimistic update
(when state (when state
(let ((target (get state "target")) (let ((target (get state "target"))
@@ -305,7 +305,7 @@
;; Returns list of (dict "element" el "swap-type" type "target-id" id). ;; Returns list of (dict "element" el "swap-type" type "target-id" id).
(let ((results (list))) (let ((results (list)))
(for-each (for-each
(fn (attr) (fn ((attr :as string))
(let ((oob-els (dom-query-all container (str "[" attr "]")))) (let ((oob-els (dom-query-all container (str "[" attr "]"))))
(for-each (for-each
(fn (oob) (fn (oob)
@@ -380,7 +380,7 @@
(reactive-attrs (if (empty? ra-str) (list) (split ra-str ",")))) (reactive-attrs (if (empty? ra-str) (list) (split ra-str ","))))
;; Add/update attributes from new, skip reactive ones ;; Add/update attributes from new, skip reactive ones
(for-each (for-each
(fn (attr) (fn ((attr :as list))
(let ((name (first attr)) (let ((name (first attr))
(val (nth attr 1))) (val (nth attr 1)))
(when (and (not (= (dom-get-attr old-el name) val)) (when (and (not (= (dom-get-attr old-el name) val))
@@ -389,7 +389,7 @@
(dom-attr-list new-el)) (dom-attr-list new-el))
;; Remove attributes not in new, skip reactive + marker attrs ;; Remove attributes not in new, skip reactive + marker attrs
(for-each (for-each
(fn (attr) (fn ((attr :as list))
(let ((aname (first attr))) (let ((aname (first attr)))
(when (and (not (dom-has-attr? new-el aname)) (when (and (not (dom-has-attr? new-el aname))
(not (contains? reactive-attrs aname)) (not (contains? reactive-attrs aname))
@@ -406,7 +406,7 @@
(new-kids (dom-child-list new-parent)) (new-kids (dom-child-list new-parent))
;; Build ID map of old children for keyed matching ;; Build ID map of old children for keyed matching
(old-by-id (reduce (old-by-id (reduce
(fn (acc kid) (fn ((acc :as dict) kid)
(let ((id (dom-id kid))) (let ((id (dom-id kid)))
(if id (do (dict-set! acc id kid) acc) acc))) (if id (do (dict-set! acc id kid) acc) acc)))
(dict) old-kids)) (dict) old-kids))
@@ -447,7 +447,7 @@
;; Remove leftover old children ;; Remove leftover old children
(for-each (for-each
(fn (i) (fn ((i :as number))
(when (>= i oi) (when (>= i oi)
(let ((leftover (nth old-kids i))) (let ((leftover (nth old-kids i)))
(when (and (dom-is-child-of? leftover old-parent) (when (and (dom-is-child-of? leftover old-parent)
@@ -577,7 +577,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define swap-dom-nodes (define swap-dom-nodes
(fn (target new-nodes strategy) (fn (target new-nodes (strategy :as string))
;; Execute a swap strategy on live DOM nodes. ;; Execute a swap strategy on live DOM nodes.
;; new-nodes is typically a DocumentFragment or Element. ;; new-nodes is typically a DocumentFragment or Element.
(case strategy (case strategy
@@ -644,7 +644,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define swap-html-string (define swap-html-string
(fn (target html strategy) (fn (target (html :as string) (strategy :as string))
;; Execute a swap strategy using an HTML string (DOMParser pipeline). ;; Execute a swap strategy using an HTML string (DOMParser pipeline).
(case strategy (case strategy
"innerHTML" "innerHTML"
@@ -675,7 +675,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define handle-history (define handle-history
(fn (el url resp-headers) (fn (el (url :as string) (resp-headers :as dict))
;; Process history push/replace based on element attrs and response headers ;; Process history push/replace based on element attrs and response headers
(let ((push-url (dom-get-attr el "sx-push-url")) (let ((push-url (dom-get-attr el "sx-push-url"))
(replace-url (dom-get-attr el "sx-replace-url")) (replace-url (dom-get-attr el "sx-replace-url"))
@@ -701,7 +701,7 @@
(define PRELOAD_TTL 30000) ;; 30 seconds (define PRELOAD_TTL 30000) ;; 30 seconds
(define preload-cache-get (define preload-cache-get
(fn (cache url) (fn ((cache :as dict) (url :as string))
;; Get and consume a cached preload response. ;; Get and consume a cached preload response.
;; Returns (dict "text" ... "content-type" ...) or nil. ;; Returns (dict "text" ... "content-type" ...) or nil.
(let ((entry (dict-get cache url))) (let ((entry (dict-get cache url)))
@@ -713,7 +713,7 @@
(define preload-cache-set (define preload-cache-set
(fn (cache url text content-type) (fn ((cache :as dict) (url :as string) (text :as string) (content-type :as string))
;; Store a preloaded response ;; Store a preloaded response
(dict-set! cache url (dict-set! cache url
(dict "text" text "content-type" content-type "timestamp" (now-ms))))) (dict "text" text "content-type" content-type "timestamp" (now-ms)))))
@@ -726,7 +726,7 @@
;; This is the logic; actual browser event binding is platform interface. ;; This is the logic; actual browser event binding is platform interface.
(define classify-trigger (define classify-trigger
(fn (trigger) (fn ((trigger :as dict))
;; Classify a parsed trigger descriptor for binding. ;; Classify a parsed trigger descriptor for binding.
;; Returns one of: "poll", "intersect", "load", "revealed", "event" ;; Returns one of: "poll", "intersect", "load", "revealed", "event"
(let ((event (get trigger "event"))) (let ((event (get trigger "event")))

101
shared/sx/ref/eval.sx
View File

@@ -73,7 +73,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define eval-expr (define eval-expr
(fn (expr env) (fn (expr (env :as dict))
(case (type-of expr) (case (type-of expr)
;; --- literals pass through --- ;; --- literals pass through ---
@@ -116,7 +116,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define eval-list (define eval-list
(fn (expr env) (fn (expr (env :as dict))
(let ((head (first expr)) (let ((head (first expr))
(args (rest expr))) (args (rest expr)))
@@ -191,7 +191,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define eval-call (define eval-call
(fn (head args env) (fn (head (args :as list) (env :as dict))
(let ((f (trampoline (eval-expr head env))) (let ((f (trampoline (eval-expr head env)))
(evaluated-args (map (fn (a) (trampoline (eval-expr a env))) args))) (evaluated-args (map (fn (a) (trampoline (eval-expr a env))) args)))
(cond (cond
@@ -215,7 +215,7 @@
(define call-lambda (define call-lambda
(fn (f args caller-env) (fn ((f :as lambda) (args :as list) (caller-env :as dict))
(let ((params (lambda-params f)) (let ((params (lambda-params f))
(local (env-merge (lambda-closure f) caller-env))) (local (env-merge (lambda-closure f) caller-env)))
;; Too many args is an error; too few pads with nil ;; Too many args is an error; too few pads with nil
@@ -235,7 +235,7 @@
(define call-component (define call-component
(fn (comp raw-args env) (fn (comp (raw-args :as list) (env :as dict))
;; Parse keyword args and children from unevaluated arg list ;; Parse keyword args and children from unevaluated arg list
(let ((parsed (parse-keyword-args raw-args env)) (let ((parsed (parse-keyword-args raw-args env))
(kwargs (first parsed)) (kwargs (first parsed))
@@ -253,7 +253,7 @@
(define parse-keyword-args (define parse-keyword-args
(fn (raw-args env) (fn ((raw-args :as list) (env :as dict))
;; Walk args: keyword + next-val → kwargs dict, else → children list ;; Walk args: keyword + next-val → kwargs dict, else → children list
(let ((kwargs (dict)) (let ((kwargs (dict))
(children (list)) (children (list))
@@ -287,7 +287,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-if (define sf-if
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((condition (trampoline (eval-expr (first args) env)))) (let ((condition (trampoline (eval-expr (first args) env))))
(if (and condition (not (nil? condition))) (if (and condition (not (nil? condition)))
(make-thunk (nth args 1) env) (make-thunk (nth args 1) env)
@@ -297,7 +297,7 @@
(define sf-when (define sf-when
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((condition (trampoline (eval-expr (first args) env)))) (let ((condition (trampoline (eval-expr (first args) env))))
(if (and condition (not (nil? condition))) (if (and condition (not (nil? condition)))
(do (do
@@ -314,18 +314,18 @@
;; Checking only the first arg is ambiguous — (nil? x) is a 2-element ;; Checking only the first arg is ambiguous — (nil? x) is a 2-element
;; function call, not a scheme clause ((test body)). ;; function call, not a scheme clause ((test body)).
(define cond-scheme? (define cond-scheme?
(fn (clauses) (fn ((clauses :as list))
(every? (fn (c) (and (= (type-of c) "list") (= (len c) 2))) (every? (fn (c) (and (= (type-of c) "list") (= (len c) 2)))
clauses))) clauses)))
(define sf-cond (define sf-cond
(fn (args env) (fn ((args :as list) (env :as dict))
(if (cond-scheme? args) (if (cond-scheme? args)
(sf-cond-scheme args env) (sf-cond-scheme args env)
(sf-cond-clojure args env)))) (sf-cond-clojure args env))))
(define sf-cond-scheme (define sf-cond-scheme
(fn (clauses env) (fn ((clauses :as list) (env :as dict))
(if (empty? clauses) (if (empty? clauses)
nil nil
(let ((clause (first clauses)) (let ((clause (first clauses))
@@ -342,7 +342,7 @@
(sf-cond-scheme (rest clauses) env))))))) (sf-cond-scheme (rest clauses) env)))))))
(define sf-cond-clojure (define sf-cond-clojure
(fn (clauses env) (fn ((clauses :as list) (env :as dict))
(if (< (len clauses) 2) (if (< (len clauses) 2)
nil nil
(let ((test (first clauses)) (let ((test (first clauses))
@@ -358,13 +358,13 @@
(define sf-case (define sf-case
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((match-val (trampoline (eval-expr (first args) env))) (let ((match-val (trampoline (eval-expr (first args) env)))
(clauses (rest args))) (clauses (rest args)))
(sf-case-loop match-val clauses env)))) (sf-case-loop match-val clauses env))))
(define sf-case-loop (define sf-case-loop
(fn (match-val clauses env) (fn (match-val (clauses :as list) (env :as dict))
(if (< (len clauses) 2) (if (< (len clauses) 2)
nil nil
(let ((test (first clauses)) (let ((test (first clauses))
@@ -380,7 +380,7 @@
(define sf-and (define sf-and
(fn (args env) (fn ((args :as list) (env :as dict))
(if (empty? args) (if (empty? args)
true true
(let ((val (trampoline (eval-expr (first args) env)))) (let ((val (trampoline (eval-expr (first args) env))))
@@ -392,7 +392,7 @@
(define sf-or (define sf-or
(fn (args env) (fn ((args :as list) (env :as dict))
(if (empty? args) (if (empty? args)
false false
(let ((val (trampoline (eval-expr (first args) env)))) (let ((val (trampoline (eval-expr (first args) env))))
@@ -402,7 +402,7 @@
(define sf-let (define sf-let
(fn (args env) (fn ((args :as list) (env :as dict))
;; Detect named let: (let name ((x 0) ...) body) ;; Detect named let: (let name ((x 0) ...) body)
;; If first arg is a symbol, delegate to sf-named-let. ;; If first arg is a symbol, delegate to sf-named-let.
(if (= (type-of (first args)) "symbol") (if (= (type-of (first args)) "symbol")
@@ -443,7 +443,7 @@
;; Desugars to a self-recursive lambda called with initial values. ;; Desugars to a self-recursive lambda called with initial values.
;; The loop name is bound in the body so recursive calls produce TCO thunks. ;; The loop name is bound in the body so recursive calls produce TCO thunks.
(define sf-named-let (define sf-named-let
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((loop-name (symbol-name (first args))) (let ((loop-name (symbol-name (first args)))
(bindings (nth args 1)) (bindings (nth args 1))
(body (slice args 2)) (body (slice args 2))
@@ -483,22 +483,29 @@
(define sf-lambda (define sf-lambda
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((params-expr (first args)) (let ((params-expr (first args))
(body-exprs (rest args)) (body-exprs (rest args))
(body (if (= (len body-exprs) 1) (body (if (= (len body-exprs) 1)
(first body-exprs) (first body-exprs)
(cons (make-symbol "begin") body-exprs))) (cons (make-symbol "begin") body-exprs)))
(param-names (map (fn (p) (param-names (map (fn (p)
(if (= (type-of p) "symbol") (cond
(symbol-name p) (= (type-of p) "symbol")
p)) (symbol-name p)
;; Annotated param: (name :as type) → extract name
(and (= (type-of p) "list")
(= (len p) 3)
(= (type-of (nth p 1)) "keyword")
(= (keyword-name (nth p 1)) "as"))
(symbol-name (first p))
:else p))
params-expr))) params-expr)))
(make-lambda param-names body env)))) (make-lambda param-names body env))))
(define sf-define (define sf-define
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((name-sym (first args)) (let ((name-sym (first args))
(value (trampoline (eval-expr (nth args 1) env)))) (value (trampoline (eval-expr (nth args 1) env))))
(when (and (lambda? value) (nil? (lambda-name value))) (when (and (lambda? value) (nil? (lambda-name value)))
@@ -508,7 +515,7 @@
(define sf-defcomp (define sf-defcomp
(fn (args env) (fn ((args :as list) (env :as dict))
;; (defcomp ~name (params) [:affinity :client|:server] body) ;; (defcomp ~name (params) [:affinity :client|:server] body)
;; Body is always the last element. Optional keyword annotations ;; Body is always the last element. Optional keyword annotations
;; may appear between the params list and the body. ;; may appear between the params list and the body.
@@ -530,7 +537,7 @@
comp)))) comp))))
(define defcomp-kwarg (define defcomp-kwarg
(fn (args key default) (fn ((args :as list) (key :as string) default)
;; Search for :key value between params (index 2) and body (last). ;; Search for :key value between params (index 2) and body (last).
(let ((end (- (len args) 1)) (let ((end (- (len args) 1))
(result default)) (result default))
@@ -546,7 +553,7 @@
result))) result)))
(define parse-comp-params (define parse-comp-params
(fn (params-expr) (fn ((params-expr :as list))
;; Parse (&key param1 param2 &children) → (params has-children param-types) ;; Parse (&key param1 param2 &children) → (params has-children param-types)
;; Also accepts &rest as synonym for &children. ;; Also accepts &rest as synonym for &children.
;; Supports typed params: (name :as type) — a 3-element list where ;; Supports typed params: (name :as type) — a 3-element list where
@@ -588,7 +595,7 @@
(define sf-defisland (define sf-defisland
(fn (args env) (fn ((args :as list) (env :as dict))
;; (defisland ~name (params) body) ;; (defisland ~name (params) body)
;; Like defcomp but creates an island (reactive component). ;; Like defcomp but creates an island (reactive component).
;; Islands have the same calling convention as components but ;; Islands have the same calling convention as components but
@@ -606,7 +613,7 @@
(define sf-defmacro (define sf-defmacro
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((name-sym (first args)) (let ((name-sym (first args))
(params-raw (nth args 1)) (params-raw (nth args 1))
(body (nth args 2)) (body (nth args 2))
@@ -618,7 +625,7 @@
mac)))) mac))))
(define parse-macro-params (define parse-macro-params
(fn (params-expr) (fn ((params-expr :as list))
;; Parse (a b &rest rest) → ((a b) rest) ;; Parse (a b &rest rest) → ((a b) rest)
(let ((params (list)) (let ((params (list))
(rest-param nil)) (rest-param nil))
@@ -639,7 +646,7 @@
(define sf-defstyle (define sf-defstyle
(fn (args env) (fn ((args :as list) (env :as dict))
;; (defstyle name expr) — bind name to evaluated expr (string, function, etc.) ;; (defstyle name expr) — bind name to evaluated expr (string, function, etc.)
(let ((name-sym (first args)) (let ((name-sym (first args))
(value (trampoline (eval-expr (nth args 1) env)))) (value (trampoline (eval-expr (nth args 1) env))))
@@ -648,7 +655,7 @@
(define sf-begin (define sf-begin
(fn (args env) (fn ((args :as list) (env :as dict))
(if (empty? args) (if (empty? args)
nil nil
(do (do
@@ -659,16 +666,16 @@
(define sf-quote (define sf-quote
(fn (args env) (fn ((args :as list) (env :as dict))
(if (empty? args) nil (first args)))) (if (empty? args) nil (first args))))
(define sf-quasiquote (define sf-quasiquote
(fn (args env) (fn ((args :as list) (env :as dict))
(qq-expand (first args) env))) (qq-expand (first args) env)))
(define qq-expand (define qq-expand
(fn (template env) (fn (template (env :as dict))
(if (not (= (type-of template) "list")) (if (not (= (type-of template) "list"))
template template
(if (empty? template) (if (empty? template)
@@ -693,7 +700,7 @@
(define sf-thread-first (define sf-thread-first
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((val (trampoline (eval-expr (first args) env)))) (let ((val (trampoline (eval-expr (first args) env))))
(reduce (reduce
(fn (result form) (fn (result form)
@@ -720,7 +727,7 @@
(define sf-set! (define sf-set!
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((name (symbol-name (first args))) (let ((name (symbol-name (first args)))
(value (trampoline (eval-expr (nth args 1) env)))) (value (trampoline (eval-expr (nth args 1) env))))
(env-set! env name value) (env-set! env name value)
@@ -741,7 +748,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-letrec (define sf-letrec
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((bindings (first args)) (let ((bindings (first args))
(body (rest args)) (body (rest args))
(local (env-extend env)) (local (env-extend env))
@@ -816,7 +823,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-dynamic-wind (define sf-dynamic-wind
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((before (trampoline (eval-expr (first args) env))) (let ((before (trampoline (eval-expr (first args) env)))
(body (trampoline (eval-expr (nth args 1) env))) (body (trampoline (eval-expr (nth args 1) env)))
(after (trampoline (eval-expr (nth args 2) env)))) (after (trampoline (eval-expr (nth args 2) env))))
@@ -835,7 +842,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define expand-macro (define expand-macro
(fn (mac raw-args env) (fn ((mac :as macro) (raw-args :as list) (env :as dict))
(let ((local (env-merge (macro-closure mac) env))) (let ((local (env-merge (macro-closure mac) env)))
;; Bind positional params (unevaluated) ;; Bind positional params (unevaluated)
(for-each (for-each
@@ -859,20 +866,20 @@
;; call-fn: unified caller for HO forms — handles both Lambda and native callable ;; call-fn: unified caller for HO forms — handles both Lambda and native callable
(define call-fn (define call-fn
(fn (f args env) (fn (f (args :as list) (env :as dict))
(cond (cond
(lambda? f) (trampoline (call-lambda f args env)) (lambda? f) (trampoline (call-lambda f args env))
(callable? f) (apply f args) (callable? f) (apply f args)
:else (error (str "Not callable in HO form: " (inspect f)))))) :else (error (str "Not callable in HO form: " (inspect f))))))
(define ho-map (define ho-map
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env))) (let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env)))) (coll (trampoline (eval-expr (nth args 1) env))))
(map (fn (item) (call-fn f (list item) env)) coll)))) (map (fn (item) (call-fn f (list item) env)) coll))))
(define ho-map-indexed (define ho-map-indexed
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env))) (let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env)))) (coll (trampoline (eval-expr (nth args 1) env))))
(map-indexed (map-indexed
@@ -880,7 +887,7 @@
coll)))) coll))))
(define ho-filter (define ho-filter
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env))) (let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env)))) (coll (trampoline (eval-expr (nth args 1) env))))
(filter (filter
@@ -888,7 +895,7 @@
coll)))) coll))))
(define ho-reduce (define ho-reduce
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env))) (let ((f (trampoline (eval-expr (first args) env)))
(init (trampoline (eval-expr (nth args 1) env))) (init (trampoline (eval-expr (nth args 1) env)))
(coll (trampoline (eval-expr (nth args 2) env)))) (coll (trampoline (eval-expr (nth args 2) env))))
@@ -898,7 +905,7 @@
coll)))) coll))))
(define ho-some (define ho-some
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env))) (let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env)))) (coll (trampoline (eval-expr (nth args 1) env))))
(some (some
@@ -906,7 +913,7 @@
coll)))) coll))))
(define ho-every (define ho-every
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env))) (let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env)))) (coll (trampoline (eval-expr (nth args 1) env))))
(every? (every?
@@ -915,7 +922,7 @@
(define ho-for-each (define ho-for-each
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env))) (let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env)))) (coll (trampoline (eval-expr (nth args 1) env))))
(for-each (for-each

22
shared/sx/ref/forms.sx
View File

@@ -22,7 +22,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define parse-key-params (define parse-key-params
(fn (params-expr) (fn ((params-expr :as list))
(let ((params (list)) (let ((params (list))
(in-key false)) (in-key false))
(for-each (for-each
@@ -42,7 +42,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-defhandler (define sf-defhandler
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((name-sym (first args)) (let ((name-sym (first args))
(params-raw (nth args 1)) (params-raw (nth args 1))
(body (nth args 2)) (body (nth args 2))
@@ -58,7 +58,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-defquery (define sf-defquery
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((name-sym (first args)) (let ((name-sym (first args))
(params-raw (nth args 1)) (params-raw (nth args 1))
(name (symbol-name name-sym)) (name (symbol-name name-sym))
@@ -77,7 +77,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-defaction (define sf-defaction
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((name-sym (first args)) (let ((name-sym (first args))
(params-raw (nth args 1)) (params-raw (nth args 1))
(name (symbol-name name-sym)) (name (symbol-name name-sym))
@@ -98,7 +98,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define sf-defpage (define sf-defpage
(fn (args env) (fn ((args :as list) (env :as dict))
(let ((name-sym (first args)) (let ((name-sym (first args))
(name (symbol-name name-sym)) (name (symbol-name name-sym))
(slots {})) (slots {}))
@@ -106,7 +106,7 @@
(let ((i 1) (let ((i 1)
(max-i (len args))) (max-i (len args)))
(for-each (for-each
(fn (idx) (fn ((idx :as number))
(when (and (< idx max-i) (when (and (< idx max-i)
(= (type-of (nth args idx)) "keyword")) (= (type-of (nth args idx)) "keyword"))
(when (< (+ idx 1) max-i) (when (< (+ idx 1) max-i)
@@ -195,28 +195,28 @@
;; Extract stream-id from a data chunk dict, defaulting to "stream-content" ;; Extract stream-id from a data chunk dict, defaulting to "stream-content"
(define stream-chunk-id (define stream-chunk-id
(fn (chunk) (fn ((chunk :as dict))
(if (has-key? chunk "stream-id") (if (has-key? chunk "stream-id")
(get chunk "stream-id") (get chunk "stream-id")
"stream-content"))) "stream-content")))
;; Remove stream-id from chunk, returning only the bindings ;; Remove stream-id from chunk, returning only the bindings
(define stream-chunk-bindings (define stream-chunk-bindings
(fn (chunk) (fn ((chunk :as dict))
(dissoc chunk "stream-id"))) (dissoc chunk "stream-id")))
;; Normalize binding keys: underscore → hyphen ;; Normalize binding keys: underscore → hyphen
(define normalize-binding-key (define normalize-binding-key
(fn (key) (fn ((key :as string))
(replace key "_" "-"))) (replace key "_" "-")))
;; Bind a data chunk's keys into a fresh env (isolated per chunk) ;; Bind a data chunk's keys into a fresh env (isolated per chunk)
(define bind-stream-chunk (define bind-stream-chunk
(fn (chunk base-env) (fn ((chunk :as dict) (base-env :as dict))
(let ((env (merge {} base-env)) (let ((env (merge {} base-env))
(bindings (stream-chunk-bindings chunk))) (bindings (stream-chunk-bindings chunk)))
(for-each (for-each
(fn (key) (fn ((key :as string))
(env-set! env (normalize-binding-key key) (env-set! env (normalize-binding-key key)
(get bindings key))) (get bindings key)))
(keys bindings)) (keys bindings))

80
shared/sx/ref/js.sx
View File

@@ -528,7 +528,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-mangle (define js-mangle
(fn (name) (fn ((name :as string))
(let ((renamed (get js-renames name))) (let ((renamed (get js-renames name)))
(if (not (nil? renamed)) (if (not (nil? renamed))
renamed renamed
@@ -549,7 +549,7 @@
result)))))))) result))))))))
(define js-kebab-to-camel (define js-kebab-to-camel
(fn (s) (fn ((s :as string))
(let ((parts (split s "-"))) (let ((parts (split s "-")))
(if (<= (len parts) 1) (if (<= (len parts) 1)
s s
@@ -557,7 +557,7 @@
(join "" (map (fn (p) (js-capitalize p)) (rest parts)))))))) (join "" (map (fn (p) (js-capitalize p)) (rest parts))))))))
(define js-capitalize (define js-capitalize
(fn (s) (fn ((s :as string))
(if (empty? s) s (if (empty? s) s
(str (upper (slice s 0 1)) (slice s 1))))) (str (upper (slice s 0 1)) (slice s 1)))))
@@ -567,7 +567,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-quote-string (define js-quote-string
(fn (s) (fn ((s :as string))
(str "\"" (str "\""
(replace (replace (replace (replace (replace (replace (replace (replace (replace (replace (replace (replace
s "\\" "\\\\") "\"" "\\\"") "\n" "\\n") "\r" "\\r") "\t" "\\t") "\0" "\\0") s "\\" "\\\\") "\"" "\\\"") "\n" "\\n") "\r" "\\r") "\t" "\\t") "\0" "\\0")
@@ -582,11 +582,11 @@
(list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod")) (list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod"))
(define js-infix? (define js-infix?
(fn (op) (fn ((op :as string))
(some (fn (x) (= x op)) js-infix-ops))) (some (fn (x) (= x op)) js-infix-ops)))
(define js-op-symbol (define js-op-symbol
(fn (op) (fn ((op :as string))
(case op (case op
"=" "==" "=" "=="
"!=" "!=" "!=" "!="
@@ -599,13 +599,13 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-is-self-tail-recursive? (define js-is-self-tail-recursive?
(fn (name body) (fn ((name :as string) (body :as list))
(if (empty? body) (if (empty? body)
false false
(js-has-tail-call? name (last body))))) (js-has-tail-call? name (last body)))))
(define js-has-tail-call? (define js-has-tail-call?
(fn (name expr) (fn ((name :as string) expr)
(if (not (and (list? expr) (not (empty? expr)))) (if (not (and (list? expr) (not (empty? expr))))
false false
(let ((head (first expr))) (let ((head (first expr)))
@@ -642,7 +642,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-tail-as-stmt (define js-emit-tail-as-stmt
(fn (name expr) (fn ((name :as string) expr)
(if (not (and (list? expr) (not (empty? expr)))) (if (not (and (list? expr) (not (empty? expr))))
(str "return " (js-expr expr) ";") (str "return " (js-expr expr) ";")
(let ((head (first expr))) (let ((head (first expr)))
@@ -702,7 +702,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-cond-as-loop-stmt (define js-emit-cond-as-loop-stmt
(fn (name clauses) (fn ((name :as string) (clauses :as list))
(if (empty? clauses) (if (empty? clauses)
"return NIL;" "return NIL;"
;; Detect scheme vs clojure ;; Detect scheme vs clojure
@@ -714,7 +714,7 @@
(js-cond-clojure-loop name clauses 0 0 false)))))) (js-cond-clojure-loop name clauses 0 0 false))))))
(define js-cond-scheme-loop (define js-cond-scheme-loop
(fn (name clauses i) (fn ((name :as string) (clauses :as list) (i :as number))
(if (>= i (len clauses)) (if (>= i (len clauses))
"else { return NIL; }" "else { return NIL; }"
(let ((clause (nth clauses i)) (let ((clause (nth clauses i))
@@ -728,7 +728,7 @@
(js-cond-scheme-loop name clauses (+ i 1)))))))) (js-cond-scheme-loop name clauses (+ i 1))))))))
(define js-cond-clojure-loop (define js-cond-clojure-loop
(fn (name clauses i clause-idx has-else) (fn ((name :as string) (clauses :as list) (i :as number) (clause-idx :as number) (has-else :as boolean))
(if (>= i (len clauses)) (if (>= i (len clauses))
(if has-else "" " else { return NIL; }") (if has-else "" " else { return NIL; }")
(let ((c (nth clauses i))) (let ((c (nth clauses i)))
@@ -749,7 +749,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-loop-body (define js-emit-loop-body
(fn (name body) (fn ((name :as string) (body :as list))
(if (empty? body) (if (empty? body)
"return NIL;" "return NIL;"
(str (join "\n" (map (fn (e) (js-statement e)) (str (join "\n" (map (fn (e) (js-statement e))
@@ -805,7 +805,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-native-dict (define js-emit-native-dict
(fn (d) (fn ((d :as dict))
(let ((items (keys d))) (let ((items (keys d)))
(str "{" (join ", " (map (fn (k) (str "{" (join ", " (map (fn (k)
(str (js-quote-string k) ": " (js-expr (get d k)))) (str (js-quote-string k) ": " (js-expr (get d k))))
@@ -963,11 +963,11 @@
(str "function(" params-str ") { " (join "\n" parts) " }"))))))))) (str "function(" params-str ") { " (join "\n" parts) " }")))))))))
(define js-collect-params (define js-collect-params
(fn (params) (fn ((params :as list))
(js-collect-params-loop params 0 (list) nil))) (js-collect-params-loop params 0 (list) nil)))
(define js-collect-params-loop (define js-collect-params-loop
(fn (params i result rest-name) (fn ((params :as list) (i :as number) (result :as list) rest-name)
(if (>= i (len params)) (if (>= i (len params))
(list result rest-name) (list result rest-name)
(let ((p (nth params i))) (let ((p (nth params i)))
@@ -975,13 +975,25 @@
;; &rest marker ;; &rest marker
(and (= (type-of p) "symbol") (= (symbol-name p) "&rest")) (and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
(if (< (+ i 1) (len params)) (if (< (+ i 1) (len params))
(js-collect-params-loop params (+ i 2) result (let ((rp (nth params (+ i 1))))
(js-mangle (symbol-name (nth params (+ i 1))))) (js-collect-params-loop params (+ i 2) result
(js-mangle
(if (and (= (type-of rp) "list") (= (len rp) 3)
(= (type-of (nth rp 1)) "keyword")
(= (keyword-name (nth rp 1)) "as"))
(symbol-name (first rp))
(if (= (type-of rp) "symbol") (symbol-name rp) (str rp))))))
(js-collect-params-loop params (+ i 1) result rest-name)) (js-collect-params-loop params (+ i 1) result rest-name))
;; Normal param ;; Normal param
(= (type-of p) "symbol") (= (type-of p) "symbol")
(js-collect-params-loop params (+ i 1) (js-collect-params-loop params (+ i 1)
(append result (js-mangle (symbol-name p))) rest-name) (append result (js-mangle (symbol-name p))) rest-name)
;; Annotated param: (name :as type) → extract name
(and (= (type-of p) "list") (= (len p) 3)
(= (type-of (nth p 1)) "keyword")
(= (keyword-name (nth p 1)) "as"))
(js-collect-params-loop params (+ i 1)
(append result (js-mangle (symbol-name (first p)))) rest-name)
;; Something else ;; Something else
:else :else
(js-collect-params-loop params (+ i 1) (js-collect-params-loop params (+ i 1)
@@ -1024,7 +1036,7 @@
(js-parse-clojure-let-bindings bindings 0 (list)))))) (js-parse-clojure-let-bindings bindings 0 (list))))))
(define js-parse-clojure-let-bindings (define js-parse-clojure-let-bindings
(fn (bindings i result) (fn (bindings (i :as number) (result :as list))
(if (>= i (- (len bindings) 1)) (if (>= i (- (len bindings) 1))
result result
(let ((vname (if (= (type-of (nth bindings i)) "symbol") (let ((vname (if (= (type-of (nth bindings i)) "symbol")
@@ -1050,7 +1062,7 @@
(str (js-emit-clojure-let-vars bindings 0 (list)) " "))))) (str (js-emit-clojure-let-vars bindings 0 (list)) " ")))))
(define js-emit-clojure-let-vars (define js-emit-clojure-let-vars
(fn (bindings i result) (fn (bindings (i :as number) (result :as list))
(if (>= i (- (len bindings) 1)) (if (>= i (- (len bindings) 1))
(join " " result) (join " " result)
(let ((vname (if (= (type-of (nth bindings i)) "symbol") (let ((vname (if (= (type-of (nth bindings i)) "symbol")
@@ -1062,7 +1074,7 @@
;; Helper to append let binding var declarations to a parts list ;; Helper to append let binding var declarations to a parts list
(define js-append-let-binding-parts (define js-append-let-binding-parts
(fn (bindings parts) (fn (bindings (parts :as list))
(when (and (list? bindings) (not (empty? bindings))) (when (and (list? bindings) (not (empty? bindings)))
(if (list? (first bindings)) (if (list? (first bindings))
;; Scheme-style ;; Scheme-style
@@ -1076,7 +1088,7 @@
(js-append-clojure-bindings bindings parts 0))))) (js-append-clojure-bindings bindings parts 0)))))
(define js-append-clojure-bindings (define js-append-clojure-bindings
(fn (bindings parts i) (fn (bindings (parts :as list) (i :as number))
(when (< i (- (len bindings) 1)) (when (< i (- (len bindings) 1))
(let ((vname (if (= (type-of (nth bindings i)) "symbol") (let ((vname (if (= (type-of (nth bindings i)) "symbol")
(symbol-name (nth bindings i)) (symbol-name (nth bindings i))
@@ -1105,7 +1117,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-cond (define js-emit-cond
(fn (clauses) (fn ((clauses :as list))
(if (empty? clauses) (if (empty? clauses)
"NIL" "NIL"
;; Detect scheme vs clojure style ;; Detect scheme vs clojure style
@@ -1123,7 +1135,7 @@
(and (= (type-of test) "keyword") (= (keyword-name test) "else"))))) (and (= (type-of test) "keyword") (= (keyword-name test) "else")))))
(define js-cond-scheme (define js-cond-scheme
(fn (clauses) (fn ((clauses :as list))
(if (empty? clauses) (if (empty? clauses)
"NIL" "NIL"
(let ((clause (first clauses)) (let ((clause (first clauses))
@@ -1135,7 +1147,7 @@
" : " (js-cond-scheme (rest clauses)) ")")))))) " : " (js-cond-scheme (rest clauses)) ")"))))))
(define js-cond-clojure (define js-cond-clojure
(fn (clauses) (fn ((clauses :as list))
(if (< (len clauses) 2) (if (< (len clauses) 2)
"NIL" "NIL"
(let ((test (first clauses)) (let ((test (first clauses))
@@ -1151,14 +1163,14 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-case (define js-emit-case
(fn (args) (fn ((args :as list))
(let ((match-expr (js-expr (first args))) (let ((match-expr (js-expr (first args)))
(clauses (rest args))) (clauses (rest args)))
(str "(function() { var _m = " match-expr "; " (str "(function() { var _m = " match-expr "; "
(js-case-chain clauses) " })()")))) (js-case-chain clauses) " })()"))))
(define js-case-chain (define js-case-chain
(fn (clauses) (fn ((clauses :as list))
(if (< (len clauses) 2) (if (< (len clauses) 2)
"return NIL;" "return NIL;"
(let ((test (nth clauses 0)) (let ((test (nth clauses 0))
@@ -1175,7 +1187,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-and (define js-emit-and
(fn (args) (fn ((args :as list))
(let ((parts (map js-expr args))) (let ((parts (map js-expr args)))
(if (= (len parts) 1) (if (= (len parts) 1)
(first parts) (first parts)
@@ -1190,7 +1202,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-or (define js-emit-or
(fn (args) (fn ((args :as list))
(if (= (len args) 1) (if (= (len args) 1)
(js-expr (first args)) (js-expr (first args))
(str "sxOr(" (join ", " (map js-expr args)) ")")))) (str "sxOr(" (join ", " (map js-expr args)) ")"))))
@@ -1201,7 +1213,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-do (define js-emit-do
(fn (args) (fn ((args :as list))
(if (= (len args) 1) (if (= (len args) 1)
(js-expr (first args)) (js-expr (first args))
(str "(" (join ", " (map js-expr args)) ")")))) (str "(" (join ", " (map js-expr args)) ")"))))
@@ -1212,11 +1224,11 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-dict-literal (define js-emit-dict-literal
(fn (pairs) (fn ((pairs :as list))
(str "{" (js-dict-pairs-str pairs 0 (list)) "}"))) (str "{" (js-dict-pairs-str pairs 0 (list)) "}")))
(define js-dict-pairs-str (define js-dict-pairs-str
(fn (pairs i result) (fn ((pairs :as list) (i :as number) (result :as list))
(if (>= i (- (len pairs) 1)) (if (>= i (- (len pairs) 1))
(join ", " result) (join ", " result)
(let ((key (nth pairs i)) (let ((key (nth pairs i))
@@ -1234,7 +1246,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-emit-infix (define js-emit-infix
(fn (op args) (fn ((op :as string) (args :as list))
(let ((js-op (js-op-symbol op))) (let ((js-op (js-op-symbol op)))
(if (and (= (len args) 1) (= op "-")) (if (and (= (len args) 1) (= op "-"))
(str "(-" (js-expr (first args)) ")") (str "(-" (js-expr (first args)) ")")
@@ -1374,7 +1386,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define js-translate-file (define js-translate-file
(fn (defines) (fn ((defines :as list))
(join "\n" (map (fn (pair) (join "\n" (map (fn (pair)
(let ((name (first pair)) (let ((name (first pair))
(expr (nth pair 1))) (expr (nth pair 1)))

100
shared/sx/ref/orchestration.sx
View File

@@ -34,7 +34,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define dispatch-trigger-events (define dispatch-trigger-events
(fn (el header-val) (fn (el (header-val :as string))
;; Dispatch events from SX-Trigger / SX-Trigger-After-Swap headers. ;; Dispatch events from SX-Trigger / SX-Trigger-After-Swap headers.
;; Value can be JSON object (name → detail) or comma-separated names. ;; Value can be JSON object (name → detail) or comma-separated names.
(when header-val (when header-val
@@ -42,12 +42,12 @@
(if parsed (if parsed
;; JSON object: keys are event names, values are detail ;; JSON object: keys are event names, values are detail
(for-each (for-each
(fn (key) (fn ((key :as string))
(dom-dispatch el key (get parsed key))) (dom-dispatch el key (get parsed key)))
(keys parsed)) (keys parsed))
;; Comma-separated event names ;; Comma-separated event names
(for-each (for-each
(fn (name) (fn ((name :as string))
(let ((trimmed (trim name))) (let ((trimmed (trim name)))
(when (not (empty? trimmed)) (when (not (empty? trimmed))
(dom-dispatch el trimmed (dict))))) (dom-dispatch el trimmed (dict)))))
@@ -73,7 +73,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define execute-request (define execute-request
(fn (el verbInfo extraParams) (fn (el (verbInfo :as dict) (extraParams :as dict))
;; Gate checks then delegate to do-fetch. ;; Gate checks then delegate to do-fetch.
;; verbInfo: dict with "method" and "url" (or nil to read from element). ;; verbInfo: dict with "method" and "url" (or nil to read from element).
;; Re-read from element in case attributes were morphed since binding. ;; Re-read from element in case attributes were morphed since binding.
@@ -106,7 +106,7 @@
(define do-fetch (define do-fetch
(fn (el verb method url extraParams) (fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
;; Execute the actual fetch. Manages abort, headers, body, loading state. ;; Execute the actual fetch. Manages abort, headers, body, loading state.
(let ((sync (dom-get-attr el "sx-sync"))) (let ((sync (dom-get-attr el "sx-sync")))
;; Abort previous if sync mode (per-element) ;; Abort previous if sync mode (per-element)
@@ -140,7 +140,7 @@
;; Merge extra params as headers ;; Merge extra params as headers
(when extraParams (when extraParams
(for-each (for-each
(fn (k) (dict-set! headers k (get extraParams k))) (fn ((k :as string)) (dict-set! headers k (get extraParams k)))
(keys extraParams))) (keys extraParams)))
;; Content-Type ;; Content-Type
@@ -172,7 +172,7 @@
"cross-origin" (cross-origin? final-url) "cross-origin" (cross-origin? final-url)
"preloaded" cached) "preloaded" cached)
;; Success callback ;; Success callback
(fn (resp-ok status get-header text) (fn ((resp-ok :as boolean) (status :as number) get-header (text :as string))
(do (do
(clear-loading-state el indicator disabled-elts) (clear-loading-state el indicator disabled-elts)
(revert-optimistic optimistic-state) (revert-optimistic optimistic-state)
@@ -202,7 +202,7 @@
(define handle-fetch-success (define handle-fetch-success
(fn (el url verb extraParams get-header text) (fn (el (url :as string) (verb :as string) (extraParams :as dict) get-header (text :as string))
;; Route a successful response through the appropriate handler. ;; Route a successful response through the appropriate handler.
(let ((resp-headers (process-response-headers get-header))) (let ((resp-headers (process-response-headers get-header)))
;; CSS hash update ;; CSS hash update
@@ -270,7 +270,7 @@
(define handle-sx-response (define handle-sx-response
(fn (el target text swap-style use-transition) (fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
;; Handle SX-format response: strip components, extract CSS, render, swap. ;; Handle SX-format response: strip components, extract CSS, render, swap.
(let ((cleaned (strip-component-scripts text))) (let ((cleaned (strip-component-scripts text)))
(let ((final (extract-response-css cleaned))) (let ((final (extract-response-css cleaned)))
@@ -281,7 +281,7 @@
(dom-append container rendered) (dom-append container rendered)
;; Process OOB swaps ;; Process OOB swaps
(process-oob-swaps container (process-oob-swaps container
(fn (t oob s) (fn (t oob (s :as string))
(dispose-islands-in t) (dispose-islands-in t)
(swap-dom-nodes t oob s) (swap-dom-nodes t oob s)
(sx-hydrate t) (sx-hydrate t)
@@ -301,7 +301,7 @@
(define handle-html-response (define handle-html-response
(fn (el target text swap-style use-transition) (fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
;; Handle HTML-format response: parse, OOB, select, swap. ;; Handle HTML-format response: parse, OOB, select, swap.
(let ((doc (dom-parse-html-document text))) (let ((doc (dom-parse-html-document text)))
(when doc (when doc
@@ -320,7 +320,7 @@
(dom-set-inner-html container (dom-body-inner-html doc)) (dom-set-inner-html container (dom-body-inner-html doc))
;; Process OOB swaps ;; Process OOB swaps
(process-oob-swaps container (process-oob-swaps container
(fn (t oob s) (fn (t oob (s :as string))
(dispose-islands-in t) (dispose-islands-in t)
(swap-dom-nodes t oob s) (swap-dom-nodes t oob s)
(post-swap t))) (post-swap t)))
@@ -338,7 +338,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define handle-retry (define handle-retry
(fn (el verb method url extraParams) (fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
;; Handle retry on failure if sx-retry is configured ;; Handle retry on failure if sx-retry is configured
(let ((retry-attr (dom-get-attr el "sx-retry")) (let ((retry-attr (dom-get-attr el "sx-retry"))
(spec (parse-retry-spec retry-attr))) (spec (parse-retry-spec retry-attr)))
@@ -358,12 +358,12 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define bind-triggers (define bind-triggers
(fn (el verbInfo) (fn (el (verbInfo :as dict))
;; Bind triggers from sx-trigger attribute (or defaults) ;; Bind triggers from sx-trigger attribute (or defaults)
(let ((triggers (or (parse-trigger-spec (dom-get-attr el "sx-trigger")) (let ((triggers (or (parse-trigger-spec (dom-get-attr el "sx-trigger"))
(default-trigger (dom-tag-name el))))) (default-trigger (dom-tag-name el)))))
(for-each (for-each
(fn (trigger) (fn ((trigger :as dict))
(let ((kind (classify-trigger trigger)) (let ((kind (classify-trigger trigger))
(mods (get trigger "modifiers"))) (mods (get trigger "modifiers")))
(cond (cond
@@ -393,7 +393,7 @@
(define bind-event (define bind-event
(fn (el event-name mods verbInfo) (fn (el (event-name :as string) (mods :as dict) (verbInfo :as dict))
;; Bind a standard DOM event trigger. ;; Bind a standard DOM event trigger.
;; Handles delay, once, changed, optimistic, preventDefault. ;; Handles delay, once, changed, optimistic, preventDefault.
(let ((timer nil) (let ((timer nil)
@@ -506,12 +506,12 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define process-oob-swaps (define process-oob-swaps
(fn (container swap-fn) (fn (container (swap-fn :as lambda))
;; Find and process out-of-band swaps in container. ;; Find and process out-of-band swaps in container.
;; swap-fn is (fn (target oob-element swap-type) ...). ;; swap-fn is (fn (target oob-element swap-type) ...).
(let ((oobs (find-oob-swaps container))) (let ((oobs (find-oob-swaps container)))
(for-each (for-each
(fn (oob) (fn ((oob :as dict))
(let ((target-id (get oob "target-id")) (let ((target-id (get oob "target-id"))
(target (dom-query-by-id target-id)) (target (dom-query-by-id target-id))
(oob-el (get oob "element")) (oob-el (get oob "element"))
@@ -610,7 +610,7 @@
(define _page-data-cache-ttl 30000) ;; 30 seconds in ms (define _page-data-cache-ttl 30000) ;; 30 seconds in ms
(define page-data-cache-key (define page-data-cache-key
(fn (page-name params) (fn ((page-name :as string) (params :as dict))
;; Build a cache key from page name + params. ;; Build a cache key from page name + params.
;; Params are from route matching so order is deterministic. ;; Params are from route matching so order is deterministic.
(let ((base page-name)) (let ((base page-name))
@@ -618,13 +618,13 @@
base base
(let ((parts (list))) (let ((parts (list)))
(for-each (for-each
(fn (k) (fn ((k :as string))
(append! parts (str k "=" (get params k)))) (append! parts (str k "=" (get params k))))
(keys params)) (keys params))
(str base ":" (join "&" parts))))))) (str base ":" (join "&" parts)))))))
(define page-data-cache-get (define page-data-cache-get
(fn (cache-key) (fn ((cache-key :as string))
;; Return cached data if fresh, else nil. ;; Return cached data if fresh, else nil.
(let ((entry (get _page-data-cache cache-key))) (let ((entry (get _page-data-cache cache-key)))
(if (nil? entry) (if (nil? entry)
@@ -636,7 +636,7 @@
(get entry "data")))))) (get entry "data"))))))
(define page-data-cache-set (define page-data-cache-set
(fn (cache-key data) (fn ((cache-key :as string) data)
;; Store data with current timestamp. ;; Store data with current timestamp.
(dict-set! _page-data-cache cache-key (dict-set! _page-data-cache cache-key
{"data" data "ts" (now-ms)}))) {"data" data "ts" (now-ms)})))
@@ -647,12 +647,12 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define invalidate-page-cache (define invalidate-page-cache
(fn (page-name) (fn ((page-name :as string))
;; Clear cached data for a page. Removes all cache entries whose key ;; Clear cached data for a page. Removes all cache entries whose key
;; matches page-name (exact) or starts with "page-name:" (with params). ;; matches page-name (exact) or starts with "page-name:" (with params).
;; Also notifies the service worker to clear its IndexedDB entries. ;; Also notifies the service worker to clear its IndexedDB entries.
(for-each (for-each
(fn (k) (fn ((k :as string))
(when (or (= k page-name) (starts-with? k (str page-name ":"))) (when (or (= k page-name) (starts-with? k (str page-name ":")))
(dict-set! _page-data-cache k nil))) (dict-set! _page-data-cache k nil)))
(keys _page-data-cache)) (keys _page-data-cache))
@@ -667,7 +667,7 @@
(log-info "sx:cache invalidate *"))) (log-info "sx:cache invalidate *")))
(define update-page-cache (define update-page-cache
(fn (page-name data) (fn ((page-name :as string) data)
;; Replace cached data for a page with server-provided data. ;; Replace cached data for a page with server-provided data.
;; Uses a bare page-name key (no params) — the server knows the ;; Uses a bare page-name key (no params) — the server knows the
;; canonical data shape for the page. ;; canonical data shape for the page.
@@ -676,7 +676,7 @@
(log-info (str "sx:cache update " page-name))))) (log-info (str "sx:cache update " page-name)))))
(define process-cache-directives (define process-cache-directives
(fn (el resp-headers response-text) (fn (el (resp-headers :as dict) (response-text :as string))
;; Process cache invalidation and update directives from both ;; Process cache invalidation and update directives from both
;; element attributes and response headers. ;; element attributes and response headers.
;; ;;
@@ -722,7 +722,7 @@
(define _optimistic-snapshots (dict)) (define _optimistic-snapshots (dict))
(define optimistic-cache-update (define optimistic-cache-update
(fn (cache-key mutator) (fn ((cache-key :as string) (mutator :as lambda))
;; Apply predicted mutation to cached data. Saves snapshot for rollback. ;; Apply predicted mutation to cached data. Saves snapshot for rollback.
;; Returns predicted data or nil if no cached data exists. ;; Returns predicted data or nil if no cached data exists.
(let ((cached (page-data-cache-get cache-key))) (let ((cached (page-data-cache-get cache-key)))
@@ -735,7 +735,7 @@
predicted))))) predicted)))))
(define optimistic-cache-revert (define optimistic-cache-revert
(fn (cache-key) (fn ((cache-key :as string))
;; Revert to pre-mutation snapshot. Returns restored data or nil. ;; Revert to pre-mutation snapshot. Returns restored data or nil.
(let ((snapshot (get _optimistic-snapshots cache-key))) (let ((snapshot (get _optimistic-snapshots cache-key)))
(when snapshot (when snapshot
@@ -744,12 +744,12 @@
snapshot)))) snapshot))))
(define optimistic-cache-confirm (define optimistic-cache-confirm
(fn (cache-key) (fn ((cache-key :as string))
;; Server accepted — discard the rollback snapshot. ;; Server accepted — discard the rollback snapshot.
(dict-delete! _optimistic-snapshots cache-key))) (dict-delete! _optimistic-snapshots cache-key)))
(define submit-mutation (define submit-mutation
(fn (page-name params action-name payload mutator-fn on-complete) (fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
;; Optimistic mutation: predict locally, send to server, confirm or revert. ;; Optimistic mutation: predict locally, send to server, confirm or revert.
;; on-complete is called with "confirmed" or "reverted" status. ;; on-complete is called with "confirmed" or "reverted" status.
(let ((cache-key (page-data-cache-key page-name params)) (let ((cache-key (page-data-cache-key page-name params))
@@ -768,7 +768,7 @@
(try-rerender-page page-name params result)) (try-rerender-page page-name params result))
(log-info (str "sx:optimistic confirmed " page-name)) (log-info (str "sx:optimistic confirmed " page-name))
(when on-complete (on-complete "confirmed"))) (when on-complete (on-complete "confirmed")))
(fn (error) (fn ((error :as string))
;; Failure: revert to snapshot ;; Failure: revert to snapshot
(let ((reverted (optimistic-cache-revert cache-key))) (let ((reverted (optimistic-cache-revert cache-key)))
(when reverted (when reverted
@@ -791,11 +791,11 @@
(fn () _is-online)) (fn () _is-online))
(define offline-set-online! (define offline-set-online!
(fn (val) (fn ((val :as boolean))
(set! _is-online val))) (set! _is-online val)))
(define offline-queue-mutation (define offline-queue-mutation
(fn (action-name payload page-name params mutator-fn) (fn ((action-name :as string) payload (page-name :as string) (params :as dict) (mutator-fn :as lambda))
;; Queue a mutation for later sync. Apply optimistic update locally. ;; Queue a mutation for later sync. Apply optimistic update locally.
(let ((cache-key (page-data-cache-key page-name params)) (let ((cache-key (page-data-cache-key page-name params))
(entry (dict (entry (dict
@@ -816,26 +816,26 @@
(define offline-sync (define offline-sync
(fn () (fn ()
;; Replay all pending mutations. Called on reconnect. ;; Replay all pending mutations. Called on reconnect.
(let ((pending (filter (fn (e) (= (get e "status") "pending")) _offline-queue))) (let ((pending (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue)))
(when (not (empty? pending)) (when (not (empty? pending))
(log-info (str "sx:offline syncing " (len pending) " mutations")) (log-info (str "sx:offline syncing " (len pending) " mutations"))
(for-each (for-each
(fn (entry) (fn ((entry :as dict))
(execute-action (get entry "action") (get entry "payload") (execute-action (get entry "action") (get entry "payload")
(fn (result) (fn (result)
(dict-set! entry "status" "synced") (dict-set! entry "status" "synced")
(log-info (str "sx:offline synced " (get entry "action")))) (log-info (str "sx:offline synced " (get entry "action"))))
(fn (error) (fn ((error :as string))
(dict-set! entry "status" "failed") (dict-set! entry "status" "failed")
(log-warn (str "sx:offline sync failed " (get entry "action") ": " error))))) (log-warn (str "sx:offline sync failed " (get entry "action") ": " error)))))
pending))))) pending)))))
(define offline-pending-count (define offline-pending-count
(fn () (fn ()
(len (filter (fn (e) (= (get e "status") "pending")) _offline-queue)))) (len (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue))))
(define offline-aware-mutation (define offline-aware-mutation
(fn (page-name params action-name payload mutator-fn on-complete) (fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
;; Top-level mutation function. Routes to submit-mutation when online, ;; Top-level mutation function. Routes to submit-mutation when online,
;; offline-queue-mutation when offline. ;; offline-queue-mutation when offline.
(if _is-online (if _is-online
@@ -860,7 +860,7 @@
(define swap-rendered-content (define swap-rendered-content
(fn (target rendered pathname) (fn (target rendered (pathname :as string))
;; Swap rendered DOM content into target and run post-processing. ;; Swap rendered DOM content into target and run post-processing.
;; Shared by pure and data page client routes. ;; Shared by pure and data page client routes.
(do (do
@@ -876,7 +876,7 @@
(define resolve-route-target (define resolve-route-target
(fn (target-sel) (fn ((target-sel :as string))
;; Resolve a target selector to a DOM element, or nil. ;; Resolve a target selector to a DOM element, or nil.
(if (and target-sel (not (= target-sel "true"))) (if (and target-sel (not (= target-sel "true")))
(dom-query target-sel) (dom-query target-sel)
@@ -884,17 +884,17 @@
(define deps-satisfied? (define deps-satisfied?
(fn (match) (fn ((match :as dict))
;; Check if all component deps for a page are loaded client-side. ;; Check if all component deps for a page are loaded client-side.
(let ((deps (get match "deps")) (let ((deps (get match "deps"))
(loaded (loaded-component-names))) (loaded (loaded-component-names)))
(if (or (nil? deps) (empty? deps)) (if (or (nil? deps) (empty? deps))
true true
(every? (fn (dep) (contains? loaded dep)) deps))))) (every? (fn ((dep :as string)) (contains? loaded dep)) deps)))))
(define try-client-route (define try-client-route
(fn (pathname target-sel) (fn ((pathname :as string) (target-sel :as string))
;; Try to render a page client-side. Returns true if successful, false otherwise. ;; Try to render a page client-side. Returns true if successful, false otherwise.
;; target-sel is the CSS selector for the swap target (from sx-boost value). ;; target-sel is the CSS selector for the swap target (from sx-boost value).
;; For pure pages: renders immediately. For :data pages: fetches data then renders. ;; For pure pages: renders immediately. For :data pages: fetches data then renders.
@@ -968,7 +968,7 @@
(do (do
(log-info (str "sx:route client+data " pathname)) (log-info (str "sx:route client+data " pathname))
(resolve-page-data page-name params (resolve-page-data page-name params
(fn (data) (fn ((data :as dict))
(page-data-cache-set cache-key data) (page-data-cache-set cache-key data)
(let ((env (merge closure params data))) (let ((env (merge closure params data)))
(if has-io (if has-io
@@ -1012,7 +1012,7 @@
(define bind-client-route-link (define bind-client-route-link
(fn (link href) (fn (link (href :as string))
;; Bind a boost link with client-side routing. If the route can be ;; Bind a boost link with client-side routing. If the route can be
;; rendered client-side (pure page, no :data), do so. Otherwise ;; rendered client-side (pure page, no :data), do so. Otherwise
;; fall back to standard server fetch via bind-boost-link. ;; fall back to standard server fetch via bind-boost-link.
@@ -1045,12 +1045,12 @@
(let ((source (event-source-connect url el)) (let ((source (event-source-connect url el))
(event-name (parse-sse-swap el))) (event-name (parse-sse-swap el)))
(event-source-listen source event-name (event-source-listen source event-name
(fn (data) (fn ((data :as string))
(bind-sse-swap el data)))))))) (bind-sse-swap el data))))))))
(define bind-sse-swap (define bind-sse-swap
(fn (el data) (fn (el (data :as string))
;; Handle an SSE event: swap data into element ;; Handle an SSE event: swap data into element
(let ((target (resolve-target el)) (let ((target (resolve-target el))
(swap-spec (parse-swap-spec (swap-spec (parse-swap-spec
@@ -1089,7 +1089,7 @@
(for-each (for-each
(fn (el) (fn (el)
(for-each (for-each
(fn (attr) (fn ((attr :as list))
(let ((name (first attr)) (let ((name (first attr))
(body (nth attr 1))) (body (nth attr 1)))
(when (starts-with? name "sx-on:") (when (starts-with? name "sx-on:")
@@ -1135,7 +1135,7 @@
(define do-preload (define do-preload
(fn (url headers) (fn ((url :as string) (headers :as dict))
;; Execute a preload fetch into the cache ;; Execute a preload fetch into the cache
(when (nil? (preload-cache-get _preload-cache url)) (when (nil? (preload-cache-get _preload-cache url))
(fetch-preload url headers _preload-cache)))) (fetch-preload url headers _preload-cache))))
@@ -1215,7 +1215,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define handle-popstate (define handle-popstate
(fn (scrollY) (fn ((scrollY :as number))
;; Handle browser back/forward navigation. ;; Handle browser back/forward navigation.
;; Derive target from [sx-boost] container or fall back to #main-panel. ;; Derive target from [sx-boost] container or fall back to #main-panel.
;; Try client-side route first, fall back to server fetch. ;; Try client-side route first, fall back to server fetch.

40
shared/sx/ref/page-helpers.sx
View File

@@ -36,7 +36,7 @@
(define extract-define-kwargs (define extract-define-kwargs
(fn (expr) (fn ((expr :as list))
;; Extract keyword args from a define-special-form expression. ;; Extract keyword args from a define-special-form expression.
;; Returns dict of keyword-name → string value. ;; Returns dict of keyword-name → string value.
;; Walks items pairwise: when item[i] is a keyword, item[i+1] is its value. ;; Walks items pairwise: when item[i] is a keyword, item[i+1] is its value.
@@ -44,7 +44,7 @@
(items (slice expr 2)) (items (slice expr 2))
(n (len items))) (n (len items)))
(for-each (for-each
(fn (idx) (fn ((idx :as number))
(when (and (< (+ idx 1) n) (when (and (< (+ idx 1) n)
(= (type-of (nth items idx)) "keyword")) (= (type-of (nth items idx)) "keyword"))
(let ((key (keyword-name (nth items idx))) (let ((key (keyword-name (nth items idx)))
@@ -58,7 +58,7 @@
(define categorize-special-forms (define categorize-special-forms
(fn (parsed-exprs) (fn ((parsed-exprs :as list))
;; parsed-exprs: result of parse-all on special-forms.sx ;; parsed-exprs: result of parse-all on special-forms.sx
;; Returns dict of category-name → list of form dicts. ;; Returns dict of category-name → list of form dicts.
(let ((categories {})) (let ((categories {}))
@@ -90,13 +90,13 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define build-ref-items-with-href (define build-ref-items-with-href
(fn (items base-path detail-keys n-fields) (fn ((items :as list) (base-path :as string) (detail-keys :as list) (n-fields :as number))
;; items: list of lists (tuples), each with n-fields elements ;; items: list of lists (tuples), each with n-fields elements
;; base-path: e.g. "/geography/hypermedia/reference/attributes/" ;; base-path: e.g. "/geography/hypermedia/reference/attributes/"
;; detail-keys: list of strings (keys that have detail pages) ;; detail-keys: list of strings (keys that have detail pages)
;; n-fields: 2 or 3 (number of fields per tuple) ;; n-fields: 2 or 3 (number of fields per tuple)
(map (map
(fn (item) (fn ((item :as list))
(if (= n-fields 3) (if (= n-fields 3)
;; [name, desc/value, exists/desc] ;; [name, desc/value, exists/desc]
(let ((name (nth item 0)) (let ((name (nth item 0))
@@ -105,7 +105,7 @@
{"name" name {"name" name
"desc" field2 "desc" field2
"exists" field3 "exists" field3
"href" (if (and field3 (some (fn (k) (= k name)) detail-keys)) "href" (if (and field3 (some (fn ((k :as string)) (= k name)) detail-keys))
(str base-path name) (str base-path name)
nil)}) nil)})
;; [name, desc] ;; [name, desc]
@@ -113,14 +113,14 @@
(desc (nth item 1))) (desc (nth item 1)))
{"name" name {"name" name
"desc" desc "desc" desc
"href" (if (some (fn (k) (= k name)) detail-keys) "href" (if (some (fn ((k :as string)) (= k name)) detail-keys)
(str base-path name) (str base-path name)
nil)}))) nil)})))
items))) items)))
(define build-reference-data (define build-reference-data
(fn (slug raw-data detail-keys) (fn ((slug :as string) (raw-data :as dict) (detail-keys :as list))
;; slug: "attributes", "headers", "events", "js-api" ;; slug: "attributes", "headers", "events", "js-api"
;; raw-data: dict with the raw data lists for this slug ;; raw-data: dict with the raw data lists for this slug
;; detail-keys: list of names that have detail pages ;; detail-keys: list of names that have detail pages
@@ -150,7 +150,7 @@
"/geography/hypermedia/reference/events/" detail-keys 2)} "/geography/hypermedia/reference/events/" detail-keys 2)}
"js-api" "js-api"
{"js-api-list" (map (fn (item) {"name" (nth item 0) "desc" (nth item 1)}) {"js-api-list" (map (fn ((item :as list)) {"name" (nth item 0) "desc" (nth item 1)})
(get raw-data "js-api-list"))} (get raw-data "js-api-list"))}
;; default: attributes ;; default: attributes
@@ -173,7 +173,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define build-attr-detail (define build-attr-detail
(fn (slug detail) (fn ((slug :as string) detail)
;; detail: dict with "description", "example", "handler", "demo" keys or nil ;; detail: dict with "description", "example", "handler", "demo" keys or nil
(if (nil? detail) (if (nil? detail)
{"attr-not-found" true} {"attr-not-found" true}
@@ -190,7 +190,7 @@
(define build-header-detail (define build-header-detail
(fn (slug detail) (fn ((slug :as string) detail)
(if (nil? detail) (if (nil? detail)
{"header-not-found" true} {"header-not-found" true}
{"header-not-found" nil {"header-not-found" nil
@@ -202,7 +202,7 @@
(define build-event-detail (define build-event-detail
(fn (slug detail) (fn ((slug :as string) detail)
(if (nil? detail) (if (nil? detail)
{"event-not-found" true} {"event-not-found" true}
{"event-not-found" nil {"event-not-found" nil
@@ -219,7 +219,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define build-component-source (define build-component-source
(fn (comp-data) (fn ((comp-data :as dict))
;; comp-data: dict with "type", "name", "params", "has-children", "body-sx", "affinity" ;; comp-data: dict with "type", "name", "params", "has-children", "body-sx", "affinity"
(let ((comp-type (get comp-data "type")) (let ((comp-type (get comp-data "type"))
(name (get comp-data "name")) (name (get comp-data "name"))
@@ -253,12 +253,12 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define build-bundle-analysis (define build-bundle-analysis
(fn (pages-raw components-raw total-components total-macros pure-count io-count) (fn ((pages-raw :as list) (components-raw :as dict) (total-components :as number) (total-macros :as number) (pure-count :as number) (io-count :as number))
;; pages-raw: list of {:name :path :direct :needed-names} ;; pages-raw: list of {:name :path :direct :needed-names}
;; components-raw: dict of name → {:is-pure :affinity :render-target :io-refs :deps :source} ;; components-raw: dict of name → {:is-pure :affinity :render-target :io-refs :deps :source}
(let ((pages-data (list))) (let ((pages-data (list)))
(for-each (for-each
(fn (page) (fn ((page :as dict))
(let ((needed-names (get page "needed-names")) (let ((needed-names (get page "needed-names"))
(n (len needed-names)) (n (len needed-names))
(pct (if (> total-components 0) (pct (if (> total-components 0)
@@ -271,7 +271,7 @@
(comp-details (list))) (comp-details (list)))
;; Walk needed components ;; Walk needed components
(for-each (for-each
(fn (comp-name) (fn ((comp-name :as string))
(let ((info (get components-raw comp-name))) (let ((info (get components-raw comp-name)))
(when (not (nil? info)) (when (not (nil? info))
(if (get info "is-pure") (if (get info "is-pure")
@@ -279,7 +279,7 @@
(do (do
(set! io-in-page (+ io-in-page 1)) (set! io-in-page (+ io-in-page 1))
(for-each (for-each
(fn (ref) (when (not (some (fn (r) (= r ref)) page-io-refs)) (fn ((ref :as string)) (when (not (some (fn ((r :as string)) (= r ref)) page-io-refs))
(append! page-io-refs ref))) (append! page-io-refs ref)))
(or (get info "io-refs") (list))))) (or (get info "io-refs") (list)))))
(append! comp-details (append! comp-details
@@ -317,13 +317,13 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define build-routing-analysis (define build-routing-analysis
(fn (pages-raw) (fn ((pages-raw :as list))
;; pages-raw: list of {:name :path :has-data :content-src} ;; pages-raw: list of {:name :path :has-data :content-src}
(let ((pages-data (list)) (let ((pages-data (list))
(client-count 0) (client-count 0)
(server-count 0)) (server-count 0))
(for-each (for-each
(fn (page) (fn ((page :as dict))
(let ((has-data (get page "has-data")) (let ((has-data (get page "has-data"))
(content-src (or (get page "content-src") "")) (content-src (or (get page "content-src") ""))
(mode nil) (mode nil)
@@ -363,6 +363,6 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define build-affinity-analysis (define build-affinity-analysis
(fn (demo-components page-plans) (fn ((demo-components :as list) (page-plans :as list))
{"components" demo-components {"components" demo-components
"page-plans" page-plans})) "page-plans" page-plans}))

8
shared/sx/ref/parser.sx
View File

@@ -50,7 +50,7 @@
;; Returns a list of top-level AST expressions. ;; Returns a list of top-level AST expressions.
(define sx-parse (define sx-parse
(fn (source) (fn ((source :as string))
(let ((pos 0) (let ((pos 0)
(len-src (len source))) (len-src (len source)))
@@ -170,7 +170,7 @@
;; -- Composite readers -- ;; -- Composite readers --
(define read-list (define read-list
(fn (close-ch) (fn ((close-ch :as string))
(let ((items (list))) (let ((items (list)))
(define read-list-loop (define read-list-loop
(fn () (fn ()
@@ -352,11 +352,11 @@
(define sx-serialize-dict (define sx-serialize-dict
(fn (d) (fn ((d :as dict))
(str "{" (str "{"
(join " " (join " "
(reduce (reduce
(fn (acc key) (fn ((acc :as list) (key :as string))
(concat acc (list (str ":" key) (sx-serialize (dict-get d key))))) (concat acc (list (str ":" key) (sx-serialize (dict-get d key)))))
(list) (list)
(keys d))) (keys d)))

60
shared/sx/ref/prove.sx
View File

@@ -25,7 +25,7 @@
;; Evaluate an SMT-LIB expression in a variable environment ;; Evaluate an SMT-LIB expression in a variable environment
(define smt-eval (define smt-eval
(fn (expr env) (fn (expr (env :as dict))
(cond (cond
;; Numbers ;; Numbers
(number? expr) expr (number? expr) expr
@@ -136,11 +136,11 @@
;; Bind parameter names to values ;; Bind parameter names to values
(define smt-bind-params (define smt-bind-params
(fn (params vals) (fn ((params :as list) (vals :as list))
(smt-bind-loop params vals {}))) (smt-bind-loop params vals {})))
(define smt-bind-loop (define smt-bind-loop
(fn (params vals acc) (fn ((params :as list) (vals :as list) (acc :as dict))
(if (or (empty? params) (empty? vals)) (if (or (empty? params) (empty? vals))
acc acc
(smt-bind-loop (rest params) (rest vals) (smt-bind-loop (rest params) (rest vals)
@@ -153,11 +153,11 @@
;; Extract declarations and assertions from parsed SMT-LIB ;; Extract declarations and assertions from parsed SMT-LIB
(define smt-extract-statements (define smt-extract-statements
(fn (exprs) (fn ((exprs :as list))
(smt-extract-loop exprs {} (list)))) (smt-extract-loop exprs {} (list))))
(define smt-extract-loop (define smt-extract-loop
(fn (exprs decls assertions) (fn ((exprs :as list) (decls :as dict) (assertions :as list))
(if (empty? exprs) (if (empty? exprs)
{:decls decls :assertions assertions} {:decls decls :assertions assertions}
(let ((expr (first exprs)) (let ((expr (first exprs))
@@ -286,7 +286,7 @@
;; Verify a single definitional assertion by construction + evaluation ;; Verify a single definitional assertion by construction + evaluation
(define smt-verify-definition (define smt-verify-definition
(fn (def-info decls) (fn ((def-info :as dict) (decls :as dict))
(let ((name (get def-info "name")) (let ((name (get def-info "name"))
(params (get def-info "params")) (params (get def-info "params"))
(body (get def-info "body")) (body (get def-info "body"))
@@ -295,10 +295,10 @@
;; Build the model: define f = λparams.body ;; Build the model: define f = λparams.body
(let ((model (assoc decls name {:params params :body body})) (let ((model (assoc decls name {:params params :body body}))
;; Select test values matching arity ;; Select test values matching arity
(tests (filter (fn (tv) (= (len tv) n-params)) smt-test-values)) (tests (filter (fn ((tv :as list)) (= (len tv) n-params)) smt-test-values))
;; Run tests ;; Run tests
(results (map (results (map
(fn (test-vals) (fn ((test-vals :as list))
(let ((env (merge model (smt-bind-params params test-vals))) (let ((env (merge model (smt-bind-params params test-vals)))
;; Evaluate body directly ;; Evaluate body directly
(body-result (smt-eval body env)) (body-result (smt-eval body env))
@@ -311,9 +311,9 @@
:equal (= body-result call-result)})) :equal (= body-result call-result)}))
tests))) tests)))
{:name name {:name name
:status (if (every? (fn (r) (get r "equal")) results) "sat" "FAIL") :status (if (every? (fn ((r :as dict)) (get r "equal")) results) "sat" "FAIL")
:proof "by construction (definition is the model)" :proof "by construction (definition is the model)"
:tests-passed (len (filter (fn (r) (get r "equal")) results)) :tests-passed (len (filter (fn ((r :as dict)) (get r "equal")) results))
:tests-total (len results) :tests-total (len results)
:sample (if (empty? results) nil (first results))})))) :sample (if (empty? results) nil (first results))}))))
@@ -325,16 +325,16 @@
;; Strip SMT-LIB comment lines (starting with ;) and return only actual forms. ;; Strip SMT-LIB comment lines (starting with ;) and return only actual forms.
;; Handles comments that contain ( characters. ;; Handles comments that contain ( characters.
(define smt-strip-comments (define smt-strip-comments
(fn (s) (fn ((s :as string))
(let ((lines (split s "\n")) (let ((lines (split s "\n"))
(non-comment (filter (non-comment (filter
(fn (line) (not (starts-with? (trim line) ";"))) (fn ((line :as string)) (not (starts-with? (trim line) ";")))
lines))) lines)))
(join "\n" non-comment)))) (join "\n" non-comment))))
;; Verify SMT-LIB output (string) — parse, classify, prove ;; Verify SMT-LIB output (string) — parse, classify, prove
(define prove-check (define prove-check
(fn (smtlib-str) (fn ((smtlib-str :as string))
(let ((parsed (sx-parse (smt-strip-comments smtlib-str))) (let ((parsed (sx-parse (smt-strip-comments smtlib-str)))
(stmts (smt-extract-statements parsed)) (stmts (smt-extract-statements parsed))
(decls (get stmts "decls")) (decls (get stmts "decls"))
@@ -351,7 +351,7 @@
{:status "unknown" {:status "unknown"
:reason "non-definitional assertion (needs full SMT solver)"})) :reason "non-definitional assertion (needs full SMT solver)"}))
assertions))) assertions)))
{:status (if (every? (fn (r) (= (get r "status") "sat")) results) {:status (if (every? (fn ((r :as dict)) (= (get r "status") "sat")) results)
"sat" "unknown") "sat" "unknown")
:assertions (len assertions) :assertions (len assertions)
:results results}))))) :results results})))))
@@ -377,7 +377,7 @@
;; Batch verify: translate and prove all define-* forms ;; Batch verify: translate and prove all define-* forms
(define prove-file (define prove-file
(fn (exprs) (fn ((exprs :as list))
(let ((translatable (let ((translatable
(filter (filter
(fn (expr) (fn (expr)
@@ -396,7 +396,7 @@
(name (nth expr 1))) (name (nth expr 1)))
(assoc proof "name" name))) (assoc proof "name" name)))
translatable)) translatable))
(sat-count (len (filter (fn (r) (= (get r "status") "sat")) results))) (sat-count (len (filter (fn ((r :as dict)) (= (get r "status") "sat")) results)))
(total (len results))) (total (len results)))
{:total total {:total total
:sat sat-count :sat sat-count
@@ -424,7 +424,7 @@
;; Default domain bounds by arity — balance coverage vs. combinatorics ;; Default domain bounds by arity — balance coverage vs. combinatorics
(define prove-domain-for (define prove-domain-for
(fn (arity) (fn ((arity :as number))
(cond (cond
(<= arity 1) (range -50 51) ;; 101 values (<= arity 1) (range -50 51) ;; 101 values
(= arity 2) (range -20 21) ;; 41^2 = 1,681 pairs (= arity 2) (range -20 21) ;; 41^2 = 1,681 pairs
@@ -433,7 +433,7 @@
;; Cartesian product: all n-tuples from a domain ;; Cartesian product: all n-tuples from a domain
(define prove-tuples (define prove-tuples
(fn (domain arity) (fn ((domain :as list) (arity :as number))
(if (<= arity 0) (list (list)) (if (<= arity 0) (list (list))
(if (= arity 1) (if (= arity 1)
(map (fn (x) (list x)) domain) (map (fn (x) (list x)) domain)
@@ -441,12 +441,12 @@
(prove-tuples-expand domain sub (list))))))) (prove-tuples-expand domain sub (list)))))))
(define prove-tuples-expand (define prove-tuples-expand
(fn (domain sub acc) (fn ((domain :as list) (sub :as list) (acc :as list))
(if (empty? domain) acc (if (empty? domain) acc
(prove-tuples-expand (prove-tuples-expand
(rest domain) sub (rest domain) sub
(append acc (append acc
(map (fn (t) (cons (first domain) t)) sub)))))) (map (fn ((t :as list)) (cons (first domain) t)) sub))))))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
@@ -454,7 +454,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define prove-call (define prove-call
(fn (f vals) (fn ((f :as lambda) (vals :as list))
(let ((n (len vals))) (let ((n (len vals)))
(cond (cond
(= n 0) (f) (= n 0) (f)
@@ -472,13 +472,13 @@
;; Search for a counterexample. Returns nil if property holds for all tested ;; Search for a counterexample. Returns nil if property holds for all tested
;; values, or the first counterexample found. ;; values, or the first counterexample found.
(define prove-search (define prove-search
(fn (test-fn given-fn domain vars) (fn ((test-fn :as lambda) given-fn (domain :as list) (vars :as list))
(let ((arity (len vars)) (let ((arity (len vars))
(tuples (prove-tuples domain arity))) (tuples (prove-tuples domain arity)))
(prove-search-loop test-fn given-fn tuples 0 0)))) (prove-search-loop test-fn given-fn tuples 0 0))))
(define prove-search-loop (define prove-search-loop
(fn (test-fn given-fn tuples tested skipped) (fn ((test-fn :as lambda) given-fn (tuples :as list) (tested :as number) (skipped :as number))
(if (empty? tuples) (if (empty? tuples)
{:status "verified" :tested tested :skipped skipped} {:status "verified" :tested tested :skipped skipped}
(let ((vals (first tuples)) (let ((vals (first tuples))
@@ -505,7 +505,7 @@
;; Verify a single property via bounded model checking ;; Verify a single property via bounded model checking
(define prove-property (define prove-property
(fn (prop) (fn ((prop :as dict))
(let ((name (get prop "name")) (let ((name (get prop "name"))
(vars (get prop "vars")) (vars (get prop "vars"))
(test-fn (get prop "test")) (test-fn (get prop "test"))
@@ -519,10 +519,10 @@
;; Batch verify a list of properties ;; Batch verify a list of properties
(define prove-properties (define prove-properties
(fn (props) (fn ((props :as list))
(let ((results (map prove-property props)) (let ((results (map prove-property props))
(verified (filter (fn (r) (= (get r "status") "verified")) results)) (verified (filter (fn ((r :as dict)) (= (get r "status") "verified")) results))
(falsified (filter (fn (r) (= (get r "status") "falsified")) results))) (falsified (filter (fn ((r :as dict)) (= (get r "status") "falsified")) results)))
{:total (len results) {:total (len results)
:verified (len verified) :verified (len verified)
:falsified (len falsified) :falsified (len falsified)
@@ -537,13 +537,13 @@
;; Generate SMT-LIB for a property — asserts (not (forall ...)) so that ;; Generate SMT-LIB for a property — asserts (not (forall ...)) so that
;; Z3 returning "unsat" proves the property holds universally. ;; Z3 returning "unsat" proves the property holds universally.
(define prove-property-smtlib (define prove-property-smtlib
(fn (prop) (fn ((prop :as dict))
(let ((name (get prop "name")) (let ((name (get prop "name"))
(vars (get prop "vars")) (vars (get prop "vars"))
(holds (get prop "holds")) (holds (get prop "holds"))
(given-e (get prop "given-expr" nil)) (given-e (get prop "given-expr" nil))
(bindings (join " " (bindings (join " "
(map (fn (v) (str "(" v " Int)")) vars))) (map (fn ((v :as string)) (str "(" v " Int)")) vars)))
(holds-smt (z3-expr holds)) (holds-smt (z3-expr holds))
(body (if (nil? given-e) (body (if (nil? given-e)
holds-smt holds-smt
@@ -556,7 +556,7 @@
;; Generate SMT-LIB for all properties, including necessary definitions ;; Generate SMT-LIB for all properties, including necessary definitions
(define prove-properties-smtlib (define prove-properties-smtlib
(fn (props primitives-exprs) (fn ((props :as list) (primitives-exprs :as list))
(let ((defs (z3-translate-file primitives-exprs)) (let ((defs (z3-translate-file primitives-exprs))
(prop-smts (map prove-property-smtlib props))) (prop-smts (map prove-property-smtlib props)))
(str ";; ================================================================\n" (str ";; ================================================================\n"

114
shared/sx/ref/py.sx
View File

@@ -253,7 +253,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-mangle (define py-mangle
(fn (name) (fn ((name :as string))
(let ((renamed (get py-renames name))) (let ((renamed (get py-renames name)))
(if (not (nil? renamed)) (if (not (nil? renamed))
renamed renamed
@@ -279,7 +279,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-quote-string (define py-quote-string
(fn (s) (fn ((s :as string))
;; Produce a Python repr-style string literal ;; Produce a Python repr-style string literal
(str "'" (replace (replace (replace (replace s "\\" "\\\\") "'" "\\'") "\n" "\\n") "\t" "\\t") "'"))) (str "'" (replace (replace (replace (replace s "\\" "\\\\") "'" "\\'") "\n" "\\n") "\t" "\\t") "'")))
@@ -292,11 +292,11 @@
(list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod")) (list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod"))
(define py-infix? (define py-infix?
(fn (op) (fn ((op :as string))
(some (fn (x) (= x op)) py-infix-ops))) (some (fn (x) (= x op)) py-infix-ops)))
(define py-op-symbol (define py-op-symbol
(fn (op) (fn ((op :as string))
(case op (case op
"=" "==" "=" "=="
"!=" "!=" "!=" "!="
@@ -309,7 +309,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-find-nested-set-vars (define py-find-nested-set-vars
(fn (body) (fn ((body :as list))
;; Returns a list of mangled variable names that are set! from within ;; Returns a list of mangled variable names that are set! from within
;; nested fn/lambda bodies ;; nested fn/lambda bodies
(let ((result (list))) (let ((result (list)))
@@ -318,7 +318,7 @@
result)))) result))))
(define py-scan-set-vars (define py-scan-set-vars
(fn (node in-nested result) (fn (node (in-nested :as boolean) (result :as list))
(when (and (list? node) (not (empty? node))) (when (and (list? node) (not (empty? node)))
(let ((head (first node))) (let ((head (first node)))
(cond (cond
@@ -353,7 +353,7 @@
(py-has-set? body)))) (py-has-set? body))))
(define py-has-set? (define py-has-set?
(fn (nodes) (fn ((nodes :as list))
(some (fn (node) (some (fn (node)
(and (list? node) (and (list? node)
(not (empty? node)) (not (empty? node))
@@ -372,7 +372,7 @@
(py-expr-with-cells expr (list)))) (py-expr-with-cells expr (list))))
(define py-expr-with-cells (define py-expr-with-cells
(fn (expr cell-vars) (fn (expr (cell-vars :as list))
(cond (cond
;; Bool MUST come before number check (Python: bool is subclass of int) ;; Bool MUST come before number check (Python: bool is subclass of int)
(= (type-of expr) "boolean") (= (type-of expr) "boolean")
@@ -417,7 +417,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-native-dict (define py-emit-native-dict
(fn (d cell-vars) (fn ((d :as dict) (cell-vars :as list))
(let ((items (keys d))) (let ((items (keys d)))
(str "{" (join ", " (map (fn (k) (str "{" (join ", " (map (fn (k)
(str (py-quote-string k) ": " (py-expr-with-cells (get d k) cell-vars))) (str (py-quote-string k) ": " (py-expr-with-cells (get d k) cell-vars)))
@@ -429,7 +429,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-list (define py-emit-list
(fn (expr cell-vars) (fn (expr (cell-vars :as list))
(let ((head (first expr)) (let ((head (first expr))
(args (rest expr))) (args (rest expr)))
(if (not (= (type-of head) "symbol")) (if (not (= (type-of head) "symbol"))
@@ -548,7 +548,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-fn (define py-emit-fn
(fn (expr cell-vars) (fn (expr (cell-vars :as list))
(let ((params (nth expr 1)) (let ((params (nth expr 1))
(body (rest (rest expr))) (body (rest (rest expr)))
(param-strs (py-collect-params params))) (param-strs (py-collect-params params)))
@@ -562,11 +562,11 @@
"\n)[-1])")))))) "\n)[-1])"))))))
(define py-collect-params (define py-collect-params
(fn (params) (fn ((params :as list))
(py-collect-params-loop params 0 (list)))) (py-collect-params-loop params 0 (list))))
(define py-collect-params-loop (define py-collect-params-loop
(fn (params i result) (fn ((params :as list) (i :as number) (result :as list))
(if (>= i (len params)) (if (>= i (len params))
result result
(let ((p (nth params i))) (let ((p (nth params i)))
@@ -574,13 +574,25 @@
;; &rest marker ;; &rest marker
(and (= (type-of p) "symbol") (= (symbol-name p) "&rest")) (and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
(if (< (+ i 1) (len params)) (if (< (+ i 1) (len params))
(py-collect-params-loop params (+ i 2) (let ((rp (nth params (+ i 1))))
(append result (str "*" (py-mangle (symbol-name (nth params (+ i 1))))))) (py-collect-params-loop params (+ i 2)
(append result (str "*" (py-mangle
(if (and (= (type-of rp) "list") (= (len rp) 3)
(= (type-of (nth rp 1)) "keyword")
(= (keyword-name (nth rp 1)) "as"))
(symbol-name (first rp))
(if (= (type-of rp) "symbol") (symbol-name rp) (str rp))))))))
(py-collect-params-loop params (+ i 1) result)) (py-collect-params-loop params (+ i 1) result))
;; Normal param ;; Normal param
(= (type-of p) "symbol") (= (type-of p) "symbol")
(py-collect-params-loop params (+ i 1) (py-collect-params-loop params (+ i 1)
(append result (py-mangle (symbol-name p)))) (append result (py-mangle (symbol-name p))))
;; Annotated param: (name :as type) → extract name
(and (= (type-of p) "list") (= (len p) 3)
(= (type-of (nth p 1)) "keyword")
(= (keyword-name (nth p 1)) "as"))
(py-collect-params-loop params (+ i 1)
(append result (py-mangle (symbol-name (first p)))))
;; Something else ;; Something else
:else :else
(py-collect-params-loop params (+ i 1) (py-collect-params-loop params (+ i 1)
@@ -592,7 +604,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-let (define py-emit-let
(fn (expr cell-vars) (fn (expr (cell-vars :as list))
(let ((bindings (nth expr 1)) (let ((bindings (nth expr 1))
(body (rest (rest expr)))) (body (rest (rest expr))))
(let ((assignments (py-parse-bindings bindings cell-vars))) (let ((assignments (py-parse-bindings bindings cell-vars)))
@@ -603,7 +615,7 @@
(py-wrap-let-bindings assignments body-str cell-vars)))))) (py-wrap-let-bindings assignments body-str cell-vars))))))
(define py-parse-bindings (define py-parse-bindings
(fn (bindings cell-vars) (fn (bindings (cell-vars :as list))
(if (and (list? bindings) (not (empty? bindings))) (if (and (list? bindings) (not (empty? bindings)))
(if (list? (first bindings)) (if (list? (first bindings))
;; Scheme-style: ((name val) ...) ;; Scheme-style: ((name val) ...)
@@ -618,7 +630,7 @@
(list)))) (list))))
(define py-parse-clojure-bindings (define py-parse-clojure-bindings
(fn (bindings i result cell-vars) (fn (bindings (i :as number) (result :as list) (cell-vars :as list))
(if (>= i (- (len bindings) 1)) (if (>= i (- (len bindings) 1))
result result
(let ((vname (if (= (type-of (nth bindings i)) "symbol") (let ((vname (if (= (type-of (nth bindings i)) "symbol")
@@ -629,7 +641,7 @@
cell-vars))))) cell-vars)))))
(define py-wrap-let-bindings (define py-wrap-let-bindings
(fn (assignments body-str cell-vars) (fn ((assignments :as list) (body-str :as string) (cell-vars :as list))
(if (empty? assignments) (if (empty? assignments)
body-str body-str
(let ((binding (last assignments)) (let ((binding (last assignments))
@@ -649,7 +661,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-when (define py-emit-when
(fn (expr cell-vars) (fn (expr (cell-vars :as list))
(let ((cond-e (py-expr-with-cells (nth expr 1) cell-vars)) (let ((cond-e (py-expr-with-cells (nth expr 1) cell-vars))
(body-parts (rest (rest expr)))) (body-parts (rest (rest expr))))
(if (= (len body-parts) 1) (if (= (len body-parts) 1)
@@ -663,7 +675,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-cond (define py-emit-cond
(fn (clauses cell-vars) (fn ((clauses :as list) (cell-vars :as list))
(if (empty? clauses) (if (empty? clauses)
"NIL" "NIL"
;; Detect scheme vs clojure style ;; Detect scheme vs clojure style
@@ -681,7 +693,7 @@
(and (= (type-of test) "keyword") (= (keyword-name test) "else"))))) (and (= (type-of test) "keyword") (= (keyword-name test) "else")))))
(define py-cond-scheme (define py-cond-scheme
(fn (clauses cell-vars) (fn ((clauses :as list) (cell-vars :as list))
(if (empty? clauses) (if (empty? clauses)
"NIL" "NIL"
(let ((clause (first clauses)) (let ((clause (first clauses))
@@ -694,7 +706,7 @@
") else " (py-cond-scheme (rest clauses) cell-vars) ")")))))) ") else " (py-cond-scheme (rest clauses) cell-vars) ")"))))))
(define py-cond-clojure (define py-cond-clojure
(fn (clauses cell-vars) (fn ((clauses :as list) (cell-vars :as list))
(if (< (len clauses) 2) (if (< (len clauses) 2)
"NIL" "NIL"
(let ((test (first clauses)) (let ((test (first clauses))
@@ -711,17 +723,17 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-case (define py-emit-case
(fn (args cell-vars) (fn ((args :as list) (cell-vars :as list))
(let ((match-expr (py-expr-with-cells (first args) cell-vars)) (let ((match-expr (py-expr-with-cells (first args) cell-vars))
(clauses (rest args))) (clauses (rest args)))
(str "_sx_case(" match-expr ", [" (py-case-pairs clauses cell-vars) "])")))) (str "_sx_case(" match-expr ", [" (py-case-pairs clauses cell-vars) "])"))))
(define py-case-pairs (define py-case-pairs
(fn (clauses cell-vars) (fn ((clauses :as list) (cell-vars :as list))
(py-case-pairs-loop clauses 0 (list) cell-vars))) (py-case-pairs-loop clauses 0 (list) cell-vars)))
(define py-case-pairs-loop (define py-case-pairs-loop
(fn (clauses i result cell-vars) (fn ((clauses :as list) (i :as number) (result :as list) (cell-vars :as list))
(if (>= i (- (len clauses) 1)) (if (>= i (- (len clauses) 1))
(join ", " result) (join ", " result)
(let ((test (nth clauses i)) (let ((test (nth clauses i))
@@ -738,28 +750,28 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-and (define py-emit-and
(fn (args cell-vars) (fn ((args :as list) (cell-vars :as list))
(let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args))) (let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args)))
(if (= (len parts) 1) (if (= (len parts) 1)
(first parts) (first parts)
(py-and-chain parts))))) (py-and-chain parts)))))
(define py-and-chain (define py-and-chain
(fn (parts) (fn ((parts :as list))
(if (= (len parts) 1) (if (= (len parts) 1)
(first parts) (first parts)
(let ((p (first parts))) (let ((p (first parts)))
(str "(" p " if not sx_truthy(" p ") else " (py-and-chain (rest parts)) ")"))))) (str "(" p " if not sx_truthy(" p ") else " (py-and-chain (rest parts)) ")")))))
(define py-emit-or (define py-emit-or
(fn (args cell-vars) (fn ((args :as list) (cell-vars :as list))
(if (= (len args) 1) (if (= (len args) 1)
(py-expr-with-cells (first args) cell-vars) (py-expr-with-cells (first args) cell-vars)
(let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args))) (let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args)))
(py-or-chain parts))))) (py-or-chain parts)))))
(define py-or-chain (define py-or-chain
(fn (parts) (fn ((parts :as list))
(if (= (len parts) 1) (if (= (len parts) 1)
(first parts) (first parts)
(let ((p (first parts))) (let ((p (first parts)))
@@ -771,7 +783,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-do (define py-emit-do
(fn (args cell-vars) (fn ((args :as list) (cell-vars :as list))
(if (= (len args) 1) (if (= (len args) 1)
(py-expr-with-cells (first args) cell-vars) (py-expr-with-cells (first args) cell-vars)
(str "_sx_begin(" (join ", " (map (fn (e) (py-expr-with-cells e cell-vars)) args)) ")")))) (str "_sx_begin(" (join ", " (map (fn (e) (py-expr-with-cells e cell-vars)) args)) ")"))))
@@ -782,11 +794,11 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-dict-literal (define py-emit-dict-literal
(fn (pairs cell-vars) (fn ((pairs :as list) (cell-vars :as list))
(str "{" (py-dict-pairs-str pairs 0 (list) cell-vars) "}"))) (str "{" (py-dict-pairs-str pairs 0 (list) cell-vars) "}")))
(define py-dict-pairs-str (define py-dict-pairs-str
(fn (pairs i result cell-vars) (fn ((pairs :as list) (i :as number) (result :as list) (cell-vars :as list))
(if (>= i (- (len pairs) 1)) (if (>= i (- (len pairs) 1))
(join ", " result) (join ", " result)
(let ((key (nth pairs i)) (let ((key (nth pairs i))
@@ -805,7 +817,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-infix (define py-emit-infix
(fn (op args cell-vars) (fn ((op :as string) (args :as list) (cell-vars :as list))
(let ((py-op (py-op-symbol op))) (let ((py-op (py-op-symbol op)))
(if (and (= (len args) 1) (= op "-")) (if (and (= (len args) 1) (= op "-"))
(str "(-" (py-expr-with-cells (first args) cell-vars) ")") (str "(-" (py-expr-with-cells (first args) cell-vars) ")")
@@ -839,15 +851,15 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-pad (define py-pad
(fn (indent) (fn ((indent :as number))
(join "" (map (fn (i) " ") (range 0 indent))))) (join "" (map (fn (i) " ") (range 0 indent)))))
(define py-statement (define py-statement
(fn (expr indent) (fn (expr (indent :as number))
(py-statement-with-cells expr indent (list)))) (py-statement-with-cells expr indent (list))))
(define py-statement-with-cells (define py-statement-with-cells
(fn (expr indent cell-vars) (fn (expr (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent))) (let ((pad (py-pad indent)))
(if (and (list? expr) (not (empty? expr)) (if (and (list? expr) (not (empty? expr))
(= (type-of (first expr)) "symbol")) (= (type-of (first expr)) "symbol"))
@@ -889,7 +901,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-define (define py-emit-define
(fn (expr indent cell-vars) (fn (expr (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent)) (let ((pad (py-pad indent))
(name (if (= (type-of (nth expr 1)) "symbol") (name (if (= (type-of (nth expr 1)) "symbol")
(symbol-name (nth expr 1)) (symbol-name (nth expr 1))
@@ -911,7 +923,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-define-as-def (define py-emit-define-as-def
(fn (name fn-expr indent) (fn ((name :as string) fn-expr (indent :as number))
(let ((pad (py-pad indent)) (let ((pad (py-pad indent))
(params (nth fn-expr 1)) (params (nth fn-expr 1))
(body (rest (rest fn-expr))) (body (rest (rest fn-expr)))
@@ -932,13 +944,13 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-body-stmts (define py-emit-body-stmts
(fn (body lines indent cell-vars) (fn ((body :as list) (lines :as list) (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent)) (let ((pad (py-pad indent))
(total (len body))) (total (len body)))
(py-emit-body-stmts-loop body lines indent cell-vars 0 total pad)))) (py-emit-body-stmts-loop body lines indent cell-vars 0 total pad))))
(define py-emit-body-stmts-loop (define py-emit-body-stmts-loop
(fn (body lines indent cell-vars i total pad) (fn ((body :as list) (lines :as list) (indent :as number) (cell-vars :as list) (i :as number) (total :as number) (pad :as string))
(when (< i total) (when (< i total)
(let ((expr (nth body i)) (let ((expr (nth body i))
(is-last (= i (- total 1)))) (is-last (= i (- total 1))))
@@ -968,7 +980,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-let-as-stmts (define py-emit-let-as-stmts
(fn (expr lines indent is-last cell-vars) (fn (expr (lines :as list) (indent :as number) (is-last :as boolean) (cell-vars :as list))
(let ((pad (py-pad indent)) (let ((pad (py-pad indent))
(bindings (nth expr 1)) (bindings (nth expr 1))
(body (rest (rest expr)))) (body (rest (rest expr))))
@@ -981,7 +993,7 @@
(for-each (fn (b) (py-emit-stmt-recursive b lines indent cell-vars)) body)))))) (for-each (fn (b) (py-emit-stmt-recursive b lines indent cell-vars)) body))))))
(define py-emit-binding-assignments (define py-emit-binding-assignments
(fn (bindings lines indent cell-vars) (fn (bindings (lines :as list) (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent))) (let ((pad (py-pad indent)))
(when (and (list? bindings) (not (empty? bindings))) (when (and (list? bindings) (not (empty? bindings)))
(if (list? (first bindings)) (if (list? (first bindings))
@@ -1002,7 +1014,7 @@
(py-emit-clojure-binding-assignments bindings lines indent 0 cell-vars)))))) (py-emit-clojure-binding-assignments bindings lines indent 0 cell-vars))))))
(define py-emit-clojure-binding-assignments (define py-emit-clojure-binding-assignments
(fn (bindings lines indent i cell-vars) (fn (bindings (lines :as list) (indent :as number) (i :as number) (cell-vars :as list))
(let ((pad (py-pad indent))) (let ((pad (py-pad indent)))
(when (< i (- (len bindings) 1)) (when (< i (- (len bindings) 1))
(let ((vname (if (= (type-of (nth bindings i)) "symbol") (let ((vname (if (= (type-of (nth bindings i)) "symbol")
@@ -1024,7 +1036,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-stmt-recursive (define py-emit-stmt-recursive
(fn (expr lines indent cell-vars) (fn (expr (lines :as list) (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent))) (let ((pad (py-pad indent)))
(if (not (and (list? expr) (not (empty? expr)))) (if (not (and (list? expr) (not (empty? expr))))
(append! lines (py-statement-with-cells expr indent cell-vars)) (append! lines (py-statement-with-cells expr indent cell-vars))
@@ -1082,7 +1094,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-cond-stmt (define py-emit-cond-stmt
(fn (expr lines indent cell-vars) (fn (expr (lines :as list) (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent)) (let ((pad (py-pad indent))
(clauses (rest expr))) (clauses (rest expr)))
;; Detect scheme vs clojure ;; Detect scheme vs clojure
@@ -1094,7 +1106,7 @@
(py-cond-stmt-clojure clauses lines indent 0 true cell-vars)))))) (py-cond-stmt-clojure clauses lines indent 0 true cell-vars))))))
(define py-cond-stmt-scheme (define py-cond-stmt-scheme
(fn (clauses lines indent first-clause cell-vars) (fn ((clauses :as list) (lines :as list) (indent :as number) (first-clause :as boolean) (cell-vars :as list))
(let ((pad (py-pad indent))) (let ((pad (py-pad indent)))
(when (not (empty? clauses)) (when (not (empty? clauses))
(let ((clause (first clauses)) (let ((clause (first clauses))
@@ -1111,7 +1123,7 @@
(py-cond-stmt-scheme (rest clauses) lines indent false cell-vars))))))) (py-cond-stmt-scheme (rest clauses) lines indent false cell-vars)))))))
(define py-cond-stmt-clojure (define py-cond-stmt-clojure
(fn (clauses lines indent i first-clause cell-vars) (fn ((clauses :as list) (lines :as list) (indent :as number) (i :as number) (first-clause :as boolean) (cell-vars :as list))
(let ((pad (py-pad indent))) (let ((pad (py-pad indent)))
(when (< i (- (len clauses) 1)) (when (< i (- (len clauses) 1))
(let ((test (nth clauses i)) (let ((test (nth clauses i))
@@ -1132,7 +1144,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-when-stmt (define py-emit-when-stmt
(fn (expr indent cell-vars) (fn (expr (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent)) (let ((pad (py-pad indent))
(cond-e (py-expr-with-cells (nth expr 1) cell-vars)) (cond-e (py-expr-with-cells (nth expr 1) cell-vars))
(body-parts (rest (rest expr)))) (body-parts (rest (rest expr))))
@@ -1146,7 +1158,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-emit-for-each-stmt (define py-emit-for-each-stmt
(fn (expr indent cell-vars) (fn (expr (indent :as number) (cell-vars :as list))
(let ((pad (py-pad indent)) (let ((pad (py-pad indent))
(fn-expr (nth expr 1)) (fn-expr (nth expr 1))
(coll-expr (nth expr 2)) (coll-expr (nth expr 2))
@@ -1175,7 +1187,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define py-translate-file (define py-translate-file
(fn (defines) (fn ((defines :as list))
(join "\n" (map (fn (pair) (join "\n" (map (fn (pair)
(let ((name (first pair)) (let ((name (first pair))
(expr (nth pair 1))) (expr (nth pair 1)))

20
shared/sx/ref/render.sx
View File

@@ -72,18 +72,18 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define definition-form? (define definition-form?
(fn (name) (fn ((name :as string))
(or (= name "define") (= name "defcomp") (= name "defisland") (or (= name "define") (= name "defcomp") (= name "defisland")
(= name "defmacro") (= name "defstyle") (= name "defhandler")))) (= name "defmacro") (= name "defstyle") (= name "defhandler"))))
(define parse-element-args (define parse-element-args
(fn (args env) (fn ((args :as list) (env :as dict))
;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list) ;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list)
(let ((attrs (dict)) (let ((attrs (dict))
(children (list))) (children (list)))
(reduce (reduce
(fn (state arg) (fn ((state :as dict) arg)
(let ((skip (get state "skip"))) (let ((skip (get state "skip")))
(if skip (if skip
(assoc state "skip" false "i" (inc (get state "i"))) (assoc state "skip" false "i" (inc (get state "i")))
@@ -101,12 +101,12 @@
(define render-attrs (define render-attrs
(fn (attrs) (fn ((attrs :as dict))
;; Render an attrs dict to an HTML attribute string. ;; Render an attrs dict to an HTML attribute string.
;; Used by adapter-html.sx and adapter-sx.sx. ;; Used by adapter-html.sx and adapter-sx.sx.
(join "" (join ""
(map (map
(fn (key) (fn ((key :as string))
(let ((val (dict-get attrs key))) (let ((val (dict-get attrs key)))
(cond (cond
;; Boolean attrs ;; Boolean attrs
@@ -133,13 +133,13 @@
;; Handles both scheme-style ((test body) ...) and clojure-style ;; Handles both scheme-style ((test body) ...) and clojure-style
;; (test body test body ...). ;; (test body test body ...).
(define eval-cond (define eval-cond
(fn (clauses env) (fn ((clauses :as list) (env :as dict))
(if (cond-scheme? clauses) (if (cond-scheme? clauses)
(eval-cond-scheme clauses env) (eval-cond-scheme clauses env)
(eval-cond-clojure clauses env)))) (eval-cond-clojure clauses env))))
(define eval-cond-scheme (define eval-cond-scheme
(fn (clauses env) (fn ((clauses :as list) (env :as dict))
(if (empty? clauses) (if (empty? clauses)
nil nil
(let ((clause (first clauses)) (let ((clause (first clauses))
@@ -156,7 +156,7 @@
(eval-cond-scheme (rest clauses) env))))))) (eval-cond-scheme (rest clauses) env)))))))
(define eval-cond-clojure (define eval-cond-clojure
(fn (clauses env) (fn ((clauses :as list) (env :as dict))
(if (< (len clauses) 2) (if (< (len clauses) 2)
nil nil
(let ((test (first clauses)) (let ((test (first clauses))
@@ -173,12 +173,12 @@
;; process-bindings: evaluate let-binding pairs, return extended env. ;; process-bindings: evaluate let-binding pairs, return extended env.
;; bindings = ((name1 expr1) (name2 expr2) ...) ;; bindings = ((name1 expr1) (name2 expr2) ...)
(define process-bindings (define process-bindings
(fn (bindings env) (fn ((bindings :as list) (env :as dict))
;; env-extend (not merge) — Env is not a dict subclass, so merge() ;; env-extend (not merge) — Env is not a dict subclass, so merge()
;; returns an empty dict, losing all parent scope bindings. ;; returns an empty dict, losing all parent scope bindings.
(let ((local (env-extend env))) (let ((local (env-extend env)))
(for-each (for-each
(fn (pair) (fn ((pair :as list))
(when (and (= (type-of pair) "list") (>= (len pair) 2)) (when (and (= (type-of pair) "list") (>= (len pair) 2))
(let ((name (if (= (type-of (first pair)) "symbol") (let ((name (if (= (type-of (first pair)) "symbol")
(symbol-name (first pair)) (symbol-name (first pair))

16
shared/sx/ref/router.sx
View File

@@ -18,7 +18,7 @@
;; "/docs/" → ("docs") ;; "/docs/" → ("docs")
(define split-path-segments (define split-path-segments
(fn (path) (fn ((path :as string))
(let ((trimmed (if (starts-with? path "/") (slice path 1) path))) (let ((trimmed (if (starts-with? path "/") (slice path 1) path)))
(let ((trimmed2 (if (and (not (empty? trimmed)) (let ((trimmed2 (if (and (not (empty? trimmed))
(ends-with? trimmed "/")) (ends-with? trimmed "/"))
@@ -36,7 +36,7 @@
;; {"type" "param" "value" "slug"}) ;; {"type" "param" "value" "slug"})
(define make-route-segment (define make-route-segment
(fn (seg) (fn ((seg :as string))
(if (and (starts-with? seg "<") (ends-with? seg ">")) (if (and (starts-with? seg "<") (ends-with? seg ">"))
(let ((param-name (slice seg 1 (- (len seg) 1)))) (let ((param-name (slice seg 1 (- (len seg) 1))))
(let ((d {})) (let ((d {}))
@@ -49,7 +49,7 @@
d)))) d))))
(define parse-route-pattern (define parse-route-pattern
(fn (pattern) (fn ((pattern :as string))
(let ((segments (split-path-segments pattern))) (let ((segments (split-path-segments pattern)))
(map make-route-segment segments)))) (map make-route-segment segments))))
@@ -60,13 +60,13 @@
;; Returns params dict if match, nil if no match. ;; Returns params dict if match, nil if no match.
(define match-route-segments (define match-route-segments
(fn (path-segs parsed-segs) (fn ((path-segs :as list) (parsed-segs :as list))
(if (not (= (len path-segs) (len parsed-segs))) (if (not (= (len path-segs) (len parsed-segs)))
nil nil
(let ((params {}) (let ((params {})
(matched true)) (matched true))
(for-each-indexed (for-each-indexed
(fn (i parsed-seg) (fn ((i :as number) (parsed-seg :as dict))
(when matched (when matched
(let ((path-seg (nth path-segs i)) (let ((path-seg (nth path-segs i))
(seg-type (get parsed-seg "type"))) (seg-type (get parsed-seg "type")))
@@ -88,7 +88,7 @@
;; Returns params dict (may be empty for exact matches) or nil. ;; Returns params dict (may be empty for exact matches) or nil.
(define match-route (define match-route
(fn (path pattern) (fn ((path :as string) (pattern :as string))
(let ((path-segs (split-path-segments path)) (let ((path-segs (split-path-segments path))
(parsed-segs (parse-route-pattern pattern))) (parsed-segs (parse-route-pattern pattern)))
(match-route-segments path-segs parsed-segs)))) (match-route-segments path-segs parsed-segs))))
@@ -101,11 +101,11 @@
;; Returns matching entry with "params" added, or nil. ;; Returns matching entry with "params" added, or nil.
(define find-matching-route (define find-matching-route
(fn (path routes) (fn ((path :as string) (routes :as list))
(let ((path-segs (split-path-segments path)) (let ((path-segs (split-path-segments path))
(result nil)) (result nil))
(for-each (for-each
(fn (route) (fn ((route :as dict))
(when (nil? result) (when (nil? result)
(let ((params (match-route-segments path-segs (get route "parsed")))) (let ((params (match-route-segments path-segs (get route "parsed"))))
(when (not (nil? params)) (when (not (nil? params))

52
shared/sx/ref/signals.sx
View File

@@ -72,7 +72,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define reset! (define reset!
(fn (s value) (fn ((s :as signal) value)
(when (signal? s) (when (signal? s)
(let ((old (signal-value s))) (let ((old (signal-value s)))
(when (not (identical? old value)) (when (not (identical? old value))
@@ -85,7 +85,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define swap! (define swap!
(fn (s f &rest args) (fn ((s :as signal) (f :as lambda) &rest args)
(when (signal? s) (when (signal? s)
(let ((old (signal-value s)) (let ((old (signal-value s))
(new-val (apply f (cons old args)))) (new-val (apply f (cons old args))))
@@ -103,7 +103,7 @@
;; by tracking deref calls during evaluation. ;; by tracking deref calls during evaluation.
(define computed (define computed
(fn (compute-fn) (fn ((compute-fn :as lambda))
(let ((s (make-signal nil)) (let ((s (make-signal nil))
(deps (list)) (deps (list))
(compute-ctx nil)) (compute-ctx nil))
@@ -113,7 +113,7 @@
(fn () (fn ()
;; Unsubscribe from old deps ;; Unsubscribe from old deps
(for-each (for-each
(fn (dep) (signal-remove-sub! dep recompute)) (fn ((dep :as signal)) (signal-remove-sub! dep recompute))
(signal-deps s)) (signal-deps s))
(signal-set-deps! s (list)) (signal-set-deps! s (list))
@@ -146,7 +146,7 @@
;; function that tears down the effect. ;; function that tears down the effect.
(define effect (define effect
(fn (effect-fn) (fn ((effect-fn :as lambda))
(let ((deps (list)) (let ((deps (list))
(disposed false) (disposed false)
(cleanup-fn nil)) (cleanup-fn nil))
@@ -159,7 +159,7 @@
;; Unsubscribe from old deps ;; Unsubscribe from old deps
(for-each (for-each
(fn (dep) (signal-remove-sub! dep run-effect)) (fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
deps) deps)
(set! deps (list)) (set! deps (list))
@@ -183,7 +183,7 @@
(set! disposed true) (set! disposed true)
(when cleanup-fn (invoke cleanup-fn)) (when cleanup-fn (invoke cleanup-fn))
(for-each (for-each
(fn (dep) (signal-remove-sub! dep run-effect)) (fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
deps) deps)
(set! deps (list))))) (set! deps (list)))))
;; Auto-register with island scope so disposal happens on swap ;; Auto-register with island scope so disposal happens on swap
@@ -202,7 +202,7 @@
(define *batch-queue* (list)) (define *batch-queue* (list))
(define batch (define batch
(fn (thunk) (fn ((thunk :as lambda))
(set! *batch-depth* (+ *batch-depth* 1)) (set! *batch-depth* (+ *batch-depth* 1))
(invoke thunk) (invoke thunk)
(set! *batch-depth* (- *batch-depth* 1)) (set! *batch-depth* (- *batch-depth* 1))
@@ -214,15 +214,15 @@
(let ((seen (list)) (let ((seen (list))
(pending (list))) (pending (list)))
(for-each (for-each
(fn (s) (fn ((s :as signal))
(for-each (for-each
(fn (sub) (fn ((sub :as lambda))
(when (not (contains? seen sub)) (when (not (contains? seen sub))
(append! seen sub) (append! seen sub)
(append! pending sub))) (append! pending sub)))
(signal-subscribers s))) (signal-subscribers s)))
queue) queue)
(for-each (fn (sub) (sub)) pending)))))) (for-each (fn ((sub :as lambda)) (sub)) pending))))))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
@@ -232,16 +232,16 @@
;; If inside a batch, queues the signal. Otherwise, notifies immediately. ;; If inside a batch, queues the signal. Otherwise, notifies immediately.
(define notify-subscribers (define notify-subscribers
(fn (s) (fn ((s :as signal))
(if (> *batch-depth* 0) (if (> *batch-depth* 0)
(when (not (contains? *batch-queue* s)) (when (not (contains? *batch-queue* s))
(append! *batch-queue* s)) (append! *batch-queue* s))
(flush-subscribers s)))) (flush-subscribers s))))
(define flush-subscribers (define flush-subscribers
(fn (s) (fn ((s :as signal))
(for-each (for-each
(fn (sub) (sub)) (fn ((sub :as lambda)) (sub))
(signal-subscribers s)))) (signal-subscribers s))))
@@ -269,10 +269,10 @@
;; For effects, the dispose function is returned by effect itself. ;; For effects, the dispose function is returned by effect itself.
(define dispose-computed (define dispose-computed
(fn (s) (fn ((s :as signal))
(when (signal? s) (when (signal? s)
(for-each (for-each
(fn (dep) (signal-remove-sub! dep nil)) (fn ((dep :as signal)) (signal-remove-sub! dep nil))
(signal-deps s)) (signal-deps s))
(signal-set-deps! s (list))))) (signal-set-deps! s (list)))))
@@ -288,7 +288,7 @@
(define *island-scope* nil) (define *island-scope* nil)
(define with-island-scope (define with-island-scope
(fn (scope-fn body-fn) (fn ((scope-fn :as lambda) (body-fn :as lambda))
(let ((prev *island-scope*)) (let ((prev *island-scope*))
(set! *island-scope* scope-fn) (set! *island-scope* scope-fn)
(let ((result (body-fn))) (let ((result (body-fn)))
@@ -300,7 +300,7 @@
;; *island-scope* is non-nil. ;; *island-scope* is non-nil.
(define register-in-scope (define register-in-scope
(fn (disposable) (fn ((disposable :as lambda))
(when *island-scope* (when *island-scope*
(*island-scope* disposable)))) (*island-scope* disposable))))
@@ -323,7 +323,7 @@
;; (dom-get-data el key) → any — retrieve stored value ;; (dom-get-data el key) → any — retrieve stored value
(define with-marsh-scope (define with-marsh-scope
(fn (marsh-el body-fn) (fn (marsh-el (body-fn :as lambda))
;; Execute body-fn collecting all disposables into a marsh-local list. ;; Execute body-fn collecting all disposables into a marsh-local list.
;; Nested under the current island scope — if the island is disposed, ;; Nested under the current island scope — if the island is disposed,
;; the marsh is disposed too (because island scope collected the marsh's ;; the marsh is disposed too (because island scope collected the marsh's
@@ -341,7 +341,7 @@
;; Parent island scope and sibling marshes are unaffected. ;; Parent island scope and sibling marshes are unaffected.
(let ((disposers (dom-get-data marsh-el "sx-marsh-disposers"))) (let ((disposers (dom-get-data marsh-el "sx-marsh-disposers")))
(when disposers (when disposers
(for-each (fn (d) (invoke d)) disposers) (for-each (fn ((d :as lambda)) (invoke d)) disposers)
(dom-set-data marsh-el "sx-marsh-disposers" nil))))) (dom-set-data marsh-el "sx-marsh-disposers" nil)))))
@@ -359,7 +359,7 @@
(define *store-registry* (dict)) (define *store-registry* (dict))
(define def-store (define def-store
(fn (name init-fn) (fn ((name :as string) (init-fn :as lambda))
(let ((registry *store-registry*)) (let ((registry *store-registry*))
;; Only create the store once — subsequent calls return existing ;; Only create the store once — subsequent calls return existing
(when (not (has-key? registry name)) (when (not (has-key? registry name))
@@ -367,7 +367,7 @@
(get *store-registry* name)))) (get *store-registry* name))))
(define use-store (define use-store
(fn (name) (fn ((name :as string))
(if (has-key? *store-registry* name) (if (has-key? *store-registry* name)
(get *store-registry* name) (get *store-registry* name)
(error (str "Store not found: " name (error (str "Store not found: " name
@@ -402,11 +402,11 @@
;; These are platform primitives because they require browser DOM APIs. ;; These are platform primitives because they require browser DOM APIs.
(define emit-event (define emit-event
(fn (el event-name detail) (fn (el (event-name :as string) detail)
(dom-dispatch el event-name detail))) (dom-dispatch el event-name detail)))
(define on-event (define on-event
(fn (el event-name handler) (fn (el (event-name :as string) (handler :as lambda))
(dom-listen el event-name handler))) (dom-listen el event-name handler)))
;; Convenience: create an effect that listens for a DOM event on an ;; Convenience: create an effect that listens for a DOM event on an
@@ -416,7 +416,7 @@
;; removed automatically via the cleanup return. ;; removed automatically via the cleanup return.
(define bridge-event (define bridge-event
(fn (el event-name target-signal transform-fn) (fn (el (event-name :as string) (target-signal :as signal) transform-fn)
(effect (fn () (effect (fn ()
(let ((remove (dom-listen el event-name (let ((remove (dom-listen el event-name
(fn (e) (fn (e)
@@ -450,7 +450,7 @@
;; (promise-then promise on-resolve on-reject) → void ;; (promise-then promise on-resolve on-reject) → void
(define resource (define resource
(fn (fetch-fn) (fn ((fetch-fn :as lambda))
(let ((state (signal (dict "loading" true "data" nil "error" nil)))) (let ((state (signal (dict "loading" true "data" nil "error" nil))))
;; Kick off the async operation ;; Kick off the async operation
(promise-then (invoke fetch-fn) (promise-then (invoke fetch-fn)

10
shared/sx/ref/sx_ref.py
View File

@@ -1498,7 +1498,7 @@ def sf_lambda(args, env):
params_expr = first(args) params_expr = first(args)
body_exprs = rest(args) body_exprs = rest(args)
body = (first(body_exprs) if sx_truthy((len(body_exprs) == 1)) else cons(make_symbol('begin'), body_exprs)) body = (first(body_exprs) if sx_truthy((len(body_exprs) == 1)) else cons(make_symbol('begin'), body_exprs))
param_names = map(lambda p: (symbol_name(p) if sx_truthy((type_of(p) == 'symbol')) else p), params_expr) param_names = map(lambda p: (symbol_name(p) if sx_truthy((type_of(p) == 'symbol')) else (symbol_name(first(p)) if sx_truthy(((type_of(p) == 'list') if not sx_truthy((type_of(p) == 'list')) else ((len(p) == 3) if not sx_truthy((len(p) == 3)) else ((type_of(nth(p, 1)) == 'keyword') if not sx_truthy((type_of(nth(p, 1)) == 'keyword')) else (keyword_name(nth(p, 1)) == 'as'))))) else p)), params_expr)
return make_lambda(param_names, body, env) return make_lambda(param_names, body, env)
# sf-define # sf-define
@@ -2661,15 +2661,15 @@ def build_ref_items_with_href(items, base_path, detail_keys, n_fields):
def build_reference_data(slug, raw_data, detail_keys): def build_reference_data(slug, raw_data, detail_keys):
_match = slug _match = slug
if _match == 'attributes': if _match == 'attributes':
return {'req-attrs': build_ref_items_with_href(get(raw_data, 'req-attrs'), '/hypermedia/reference/attributes/', detail_keys, 3), 'beh-attrs': build_ref_items_with_href(get(raw_data, 'beh-attrs'), '/hypermedia/reference/attributes/', detail_keys, 3), 'uniq-attrs': build_ref_items_with_href(get(raw_data, 'uniq-attrs'), '/hypermedia/reference/attributes/', detail_keys, 3)} return {'req-attrs': build_ref_items_with_href(get(raw_data, 'req-attrs'), '/geography/hypermedia/reference/attributes/', detail_keys, 3), 'beh-attrs': build_ref_items_with_href(get(raw_data, 'beh-attrs'), '/geography/hypermedia/reference/attributes/', detail_keys, 3), 'uniq-attrs': build_ref_items_with_href(get(raw_data, 'uniq-attrs'), '/geography/hypermedia/reference/attributes/', detail_keys, 3)}
elif _match == 'headers': elif _match == 'headers':
return {'req-headers': build_ref_items_with_href(get(raw_data, 'req-headers'), '/hypermedia/reference/headers/', detail_keys, 3), 'resp-headers': build_ref_items_with_href(get(raw_data, 'resp-headers'), '/hypermedia/reference/headers/', detail_keys, 3)} return {'req-headers': build_ref_items_with_href(get(raw_data, 'req-headers'), '/geography/hypermedia/reference/headers/', detail_keys, 3), 'resp-headers': build_ref_items_with_href(get(raw_data, 'resp-headers'), '/geography/hypermedia/reference/headers/', detail_keys, 3)}
elif _match == 'events': elif _match == 'events':
return {'events-list': build_ref_items_with_href(get(raw_data, 'events-list'), '/hypermedia/reference/events/', detail_keys, 2)} return {'events-list': build_ref_items_with_href(get(raw_data, 'events-list'), '/geography/hypermedia/reference/events/', detail_keys, 2)}
elif _match == 'js-api': elif _match == 'js-api':
return {'js-api-list': map(lambda item: {'name': nth(item, 0), 'desc': nth(item, 1)}, get(raw_data, 'js-api-list'))} return {'js-api-list': map(lambda item: {'name': nth(item, 0), 'desc': nth(item, 1)}, get(raw_data, 'js-api-list'))}
else: else:
return {'req-attrs': build_ref_items_with_href(get(raw_data, 'req-attrs'), '/hypermedia/reference/attributes/', detail_keys, 3), 'beh-attrs': build_ref_items_with_href(get(raw_data, 'beh-attrs'), '/hypermedia/reference/attributes/', detail_keys, 3), 'uniq-attrs': build_ref_items_with_href(get(raw_data, 'uniq-attrs'), '/hypermedia/reference/attributes/', detail_keys, 3)} return {'req-attrs': build_ref_items_with_href(get(raw_data, 'req-attrs'), '/geography/hypermedia/reference/attributes/', detail_keys, 3), 'beh-attrs': build_ref_items_with_href(get(raw_data, 'beh-attrs'), '/geography/hypermedia/reference/attributes/', detail_keys, 3), 'uniq-attrs': build_ref_items_with_href(get(raw_data, 'uniq-attrs'), '/geography/hypermedia/reference/attributes/', detail_keys, 3)}
# build-attr-detail # build-attr-detail
def build_attr_detail(slug, detail): def build_attr_detail(slug, detail):

24
shared/sx/ref/types.sx
View File

@@ -165,7 +165,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define narrow-type (define narrow-type
(fn (t predicate-name) (fn (t (predicate-name :as string))
;; Narrow type based on a predicate test in a truthy branch. ;; Narrow type based on a predicate test in a truthy branch.
;; (if (nil? x) ..then.. ..else..) → in else, x excludes nil. ;; (if (nil? x) ..then.. ..else..) → in else, x excludes nil.
;; Returns (narrowed-then narrowed-else). ;; Returns (narrowed-then narrowed-else).
@@ -224,7 +224,7 @@
;; type-env is a dict mapping variable names → types. ;; type-env is a dict mapping variable names → types.
(define infer-type (define infer-type
(fn (node type-env prim-types) (fn (node (type-env :as dict) (prim-types :as dict))
(let ((kind (type-of node))) (let ((kind (type-of node)))
(if (= kind "number") "number" (if (= kind "number") "number"
(if (= kind "string") "string" (if (= kind "string") "string"
@@ -251,7 +251,7 @@
(define infer-list-type (define infer-list-type
(fn (node type-env prim-types) (fn (node (type-env :as dict) (prim-types :as dict))
;; Infer type of a list expression (function call, special form, etc.) ;; Infer type of a list expression (function call, special form, etc.)
(if (empty? node) "list" (if (empty? node) "list"
(let ((head (first node)) (let ((head (first node))
@@ -320,7 +320,7 @@
(define infer-if-type (define infer-if-type
(fn (args type-env prim-types) (fn ((args :as list) (type-env :as dict) (prim-types :as dict))
;; (if test then else?) → union of then and else types ;; (if test then else?) → union of then and else types
(if (< (len args) 2) "nil" (if (< (len args) 2) "nil"
(let ((then-type (infer-type (nth args 1) type-env prim-types))) (let ((then-type (infer-type (nth args 1) type-env prim-types)))
@@ -330,7 +330,7 @@
(define infer-let-type (define infer-let-type
(fn (args type-env prim-types) (fn ((args :as list) (type-env :as dict) (prim-types :as dict))
;; (let ((x expr) ...) body) → type of body in extended type-env ;; (let ((x expr) ...) body) → type of body in extended type-env
(if (< (len args) 2) "nil" (if (< (len args) 2) "nil"
(let ((bindings (first args)) (let ((bindings (first args))
@@ -359,7 +359,7 @@
;; :expr <the offending AST node>} ;; :expr <the offending AST node>}
(define make-diagnostic (define make-diagnostic
(fn (level message component expr) (fn ((level :as string) (message :as string) component expr)
{:level level {:level level
:message message :message message
:component component :component component
@@ -371,7 +371,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define check-primitive-call (define check-primitive-call
(fn (name args type-env prim-types prim-param-types comp-name) (fn ((name :as string) (args :as list) (type-env :as dict) (prim-types :as dict) prim-param-types (comp-name :as string))
;; Check a primitive call site against declared param types. ;; Check a primitive call site against declared param types.
;; prim-param-types is a dict: {prim-name → {:positional [...] :rest-type type-or-nil}} ;; prim-param-types is a dict: {prim-name → {:positional [...] :rest-type type-or-nil}}
;; Each positional entry is a list (name type-or-nil). ;; Each positional entry is a list (name type-or-nil).
@@ -418,7 +418,7 @@
(define check-component-call (define check-component-call
(fn (comp-name comp call-args type-env prim-types) (fn ((comp-name :as string) (comp :as component) (call-args :as list) (type-env :as dict) (prim-types :as dict))
;; Check a component call site against its declared param types. ;; Check a component call site against its declared param types.
;; comp is the component value, call-args is the list of args ;; comp is the component value, call-args is the list of args
;; from the call site (after the component name). ;; from the call site (after the component name).
@@ -482,7 +482,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define check-body-walk (define check-body-walk
(fn (node comp-name type-env prim-types prim-param-types env diagnostics) (fn (node (comp-name :as string) (type-env :as dict) (prim-types :as dict) prim-param-types env (diagnostics :as list))
;; Recursively walk an AST and collect diagnostics. ;; Recursively walk an AST and collect diagnostics.
;; prim-param-types: dict of {name → {:positional [...] :rest-type t}} or nil ;; prim-param-types: dict of {name → {:positional [...] :rest-type t}} or nil
(let ((kind (type-of node))) (let ((kind (type-of node)))
@@ -556,7 +556,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define check-component (define check-component
(fn (comp-name env prim-types prim-param-types) (fn ((comp-name :as string) env (prim-types :as dict) prim-param-types)
;; Type-check a component's body. Returns list of diagnostics. ;; Type-check a component's body. Returns list of diagnostics.
;; prim-param-types: dict of param type info, or nil to skip primitive checking. ;; prim-param-types: dict of param type info, or nil to skip primitive checking.
(let ((comp (env-get env comp-name)) (let ((comp (env-get env comp-name))
@@ -589,7 +589,7 @@
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
(define check-all (define check-all
(fn (env prim-types prim-param-types) (fn (env (prim-types :as dict) prim-param-types)
;; Type-check every component in the environment. ;; Type-check every component in the environment.
;; prim-param-types: dict of param type info, or nil to skip primitive checking. ;; prim-param-types: dict of param type info, or nil to skip primitive checking.
;; Returns list of all diagnostics. ;; Returns list of all diagnostics.
@@ -613,7 +613,7 @@
;; This is called by the host at startup with the parsed declarations. ;; This is called by the host at startup with the parsed declarations.
(define build-type-registry (define build-type-registry
(fn (prim-declarations io-declarations) (fn ((prim-declarations :as list) (io-declarations :as list))
;; Both are lists of dicts: {:name "+" :returns "number" :params (...)} ;; Both are lists of dicts: {:name "+" :returns "number" :params (...)}
;; Returns a flat dict: {"+" "number", "str" "string", ...} ;; Returns a flat dict: {"+" "number", "str" "string", ...}
(let ((registry (dict))) (let ((registry (dict)))