Move defstyle/deftype/defeffect to web-forms.sx — domain forms, not core
These are domain definition forms (same pattern as defhandler, defpage, etc.), not core language constructs. Moving them to web-forms.sx keeps the core evaluator + types.sx cleaner for WASM compilation. web-forms.sx now loaded in both JS and Python build pipelines. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -136,6 +136,7 @@ def compile_ref_to_js(
|
|||||||
("freeze.sx", "freeze (serializable state boundaries)"),
|
("freeze.sx", "freeze (serializable state boundaries)"),
|
||||||
("content.sx", "content (content-addressed computation)"),
|
("content.sx", "content (content-addressed computation)"),
|
||||||
("render.sx", "render (core)"),
|
("render.sx", "render (core)"),
|
||||||
|
("web-forms.sx", "web-forms (defstyle, deftype, defeffect, defrelation)"),
|
||||||
]
|
]
|
||||||
for name in ("parser", "html", "sx", "dom", "engine", "orchestration", "boot"):
|
for name in ("parser", "html", "sx", "dom", "engine", "orchestration", "boot"):
|
||||||
if name in adapter_set:
|
if name in adapter_set:
|
||||||
|
|||||||
@@ -1498,6 +1498,7 @@ def compile_ref_to_py(
|
|||||||
sx_files = [
|
sx_files = [
|
||||||
("evaluator.sx", "evaluator (frames + eval + CEK)"),
|
("evaluator.sx", "evaluator (frames + eval + CEK)"),
|
||||||
("forms.sx", "forms (server definition forms)"),
|
("forms.sx", "forms (server definition forms)"),
|
||||||
|
("web-forms.sx", "web-forms (defstyle, deftype, defeffect, defrelation)"),
|
||||||
("render.sx", "render (core)"),
|
("render.sx", "render (core)"),
|
||||||
]
|
]
|
||||||
# Parser before html/sx — provides serialize used by adapters
|
# Parser before html/sx — provides serialize used by adapters
|
||||||
|
|||||||
@@ -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-24T12:07:57Z";
|
var SX_VERSION = "2026-03-24T12:19:33Z";
|
||||||
|
|
||||||
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); }
|
||||||
@@ -2338,6 +2338,171 @@ PRIMITIVES["escape-html"] = escapeHtml;
|
|||||||
PRIMITIVES["escape-attr"] = escapeAttr;
|
PRIMITIVES["escape-attr"] = escapeAttr;
|
||||||
|
|
||||||
|
|
||||||
|
// === Transpiled from web-forms (defstyle, deftype, defeffect, defrelation) ===
|
||||||
|
|
||||||
|
// parse-key-params
|
||||||
|
var parseKeyParams = function(paramsExpr) { return (function() {
|
||||||
|
var params = [];
|
||||||
|
{ var _c = paramsExpr; for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; if (isSxTruthy((typeOf(p) == "symbol"))) {
|
||||||
|
(function() {
|
||||||
|
var name = symbolName(p);
|
||||||
|
return (isSxTruthy(!isSxTruthy((name == "&key"))) ? append_b(params, name) : NIL);
|
||||||
|
})();
|
||||||
|
} } }
|
||||||
|
return params;
|
||||||
|
})(); };
|
||||||
|
PRIMITIVES["parse-key-params"] = parseKeyParams;
|
||||||
|
|
||||||
|
// parse-handler-args
|
||||||
|
var parseHandlerArgs = function(args) { return (function() {
|
||||||
|
var opts = {};
|
||||||
|
var params = [];
|
||||||
|
var body = NIL;
|
||||||
|
var i = 0;
|
||||||
|
var n = len(args);
|
||||||
|
var done = false;
|
||||||
|
{ var _c = range(0, n); for (var _i = 0; _i < _c.length; _i++) { var idx = _c[_i]; if (isSxTruthy((isSxTruthy(!isSxTruthy(done)) && (idx == i)))) {
|
||||||
|
(function() {
|
||||||
|
var arg = nth(args, idx);
|
||||||
|
return (isSxTruthy((typeOf(arg) == "keyword")) ? ((isSxTruthy(((idx + 1) < n)) ? (function() {
|
||||||
|
var val = nth(args, (idx + 1));
|
||||||
|
return dictSet(opts, keywordName(arg), (isSxTruthy((typeOf(val) == "keyword")) ? keywordName(val) : val));
|
||||||
|
})() : NIL), (i = (idx + 2))) : (isSxTruthy((typeOf(arg) == "list")) ? ((params = parseKeyParams(arg)), (isSxTruthy(((idx + 1) < n)) ? (body = nth(args, (idx + 1))) : NIL), (done = true)) : ((body = arg), (done = true))));
|
||||||
|
})();
|
||||||
|
} } }
|
||||||
|
return {["opts"]: opts, ["params"]: params, ["body"]: body};
|
||||||
|
})(); };
|
||||||
|
PRIMITIVES["parse-handler-args"] = parseHandlerArgs;
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("defhandler", function(args, env) { return (function() {
|
||||||
|
var nameSym = first(args);
|
||||||
|
var name = symbolName(first(args));
|
||||||
|
var parsed = parseHandlerArgs(rest(args));
|
||||||
|
var opts = get(parsed, "opts");
|
||||||
|
var params = get(parsed, "params");
|
||||||
|
var body = get(parsed, "body");
|
||||||
|
return (function() {
|
||||||
|
var hdef = {["__type"]: "handler", ["name"]: name, ["params"]: params, ["body"]: body, ["closure"]: env, ["path"]: sxOr(get(opts, "path"), NIL), ["method"]: sxOr(get(opts, "method"), "get"), ["csrf"]: (function() {
|
||||||
|
var v = get(opts, "csrf");
|
||||||
|
return (isSxTruthy(isNil(v)) ? true : v);
|
||||||
|
})(), ["returns"]: sxOr(get(opts, "returns"), "element")};
|
||||||
|
envBind(env, (String("handler:") + String(name)), hdef);
|
||||||
|
return hdef;
|
||||||
|
})();
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("defquery", function(args, env) { return (function() {
|
||||||
|
var name = symbolName(first(args));
|
||||||
|
var paramsRaw = nth(args, 1);
|
||||||
|
var params = parseKeyParams(paramsRaw);
|
||||||
|
var hasDoc = (isSxTruthy((len(args) >= 4)) && (typeOf(nth(args, 2)) == "string"));
|
||||||
|
var doc = (isSxTruthy(hasDoc) ? nth(args, 2) : "");
|
||||||
|
var body = (isSxTruthy(hasDoc) ? nth(args, 3) : nth(args, 2));
|
||||||
|
return (function() {
|
||||||
|
var qdef = {["__type"]: "query", ["name"]: name, ["params"]: params, ["doc"]: doc, ["body"]: body, ["closure"]: env};
|
||||||
|
envBind(env, (String("query:") + String(name)), qdef);
|
||||||
|
return qdef;
|
||||||
|
})();
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("defaction", function(args, env) { return (function() {
|
||||||
|
var name = symbolName(first(args));
|
||||||
|
var paramsRaw = nth(args, 1);
|
||||||
|
var params = parseKeyParams(paramsRaw);
|
||||||
|
var hasDoc = (isSxTruthy((len(args) >= 4)) && (typeOf(nth(args, 2)) == "string"));
|
||||||
|
var doc = (isSxTruthy(hasDoc) ? nth(args, 2) : "");
|
||||||
|
var body = (isSxTruthy(hasDoc) ? nth(args, 3) : nth(args, 2));
|
||||||
|
return (function() {
|
||||||
|
var adef = {["__type"]: "action", ["name"]: name, ["params"]: params, ["doc"]: doc, ["body"]: body, ["closure"]: env};
|
||||||
|
envBind(env, (String("action:") + String(name)), adef);
|
||||||
|
return adef;
|
||||||
|
})();
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("defpage", function(args, env) { return (function() {
|
||||||
|
var name = symbolName(first(args));
|
||||||
|
var slots = {};
|
||||||
|
var n = len(args);
|
||||||
|
{ var _c = range(0, ((n - 1) / 2)); for (var _i = 0; _i < _c.length; _i++) { var idx = _c[_i]; (function() {
|
||||||
|
var kIdx = (1 + (idx * 2));
|
||||||
|
var vIdx = (2 + (idx * 2));
|
||||||
|
return (isSxTruthy((isSxTruthy((kIdx < n)) && isSxTruthy((vIdx < n)) && (typeOf(nth(args, kIdx)) == "keyword"))) ? dictSet(slots, keywordName(nth(args, kIdx)), nth(args, vIdx)) : NIL);
|
||||||
|
})(); } }
|
||||||
|
return (function() {
|
||||||
|
var pdef = {["__type"]: "page", ["name"]: name, ["path"]: sxOr(get(slots, "path"), ""), ["auth"]: sxOr(get(slots, "auth"), "public"), ["layout"]: get(slots, "layout"), ["data"]: get(slots, "data"), ["content"]: get(slots, "content"), ["filter"]: get(slots, "filter"), ["aside"]: get(slots, "aside"), ["menu"]: get(slots, "menu"), ["stream"]: get(slots, "stream"), ["fallback"]: get(slots, "fallback"), ["shell"]: get(slots, "shell"), ["closure"]: env};
|
||||||
|
envBind(env, (String("page:") + String(name)), pdef);
|
||||||
|
return pdef;
|
||||||
|
})();
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("defrelation", function(args, env) { return (function() {
|
||||||
|
var name = symbolName(first(args));
|
||||||
|
var slots = {};
|
||||||
|
var n = len(args);
|
||||||
|
{ var _c = range(0, ((n - 1) / 2)); for (var _i = 0; _i < _c.length; _i++) { var idx = _c[_i]; (function() {
|
||||||
|
var kIdx = (1 + (idx * 2));
|
||||||
|
var vIdx = (2 + (idx * 2));
|
||||||
|
return (isSxTruthy((isSxTruthy((kIdx < n)) && isSxTruthy((vIdx < n)) && (typeOf(nth(args, kIdx)) == "keyword"))) ? dictSet(slots, keywordName(nth(args, kIdx)), nth(args, vIdx)) : NIL);
|
||||||
|
})(); } }
|
||||||
|
return (function() {
|
||||||
|
var rdef = {["__type"]: "relation", ["name"]: name, ["slots"]: slots, ["closure"]: env};
|
||||||
|
envBind(env, (String("relation:") + String(name)), rdef);
|
||||||
|
return rdef;
|
||||||
|
})();
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("defstyle", function(args, env) { return (function() {
|
||||||
|
var nameSym = first(args);
|
||||||
|
var value = trampoline(evalExpr(nth(args, 1), env));
|
||||||
|
envBind(env, symbolName(nameSym), value);
|
||||||
|
return value;
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// normalize-type-body
|
||||||
|
var normalizeTypeBody = function(body) { return (isSxTruthy(isNil(body)) ? "nil" : (isSxTruthy((typeOf(body) == "symbol")) ? symbolName(body) : (isSxTruthy((typeOf(body) == "string")) ? body : (isSxTruthy((typeOf(body) == "keyword")) ? keywordName(body) : (isSxTruthy((typeOf(body) == "dict")) ? mapDict(function(k, v) { return normalizeTypeBody(v); }, body) : (isSxTruthy((typeOf(body) == "list")) ? (isSxTruthy(isEmpty(body)) ? "any" : (function() {
|
||||||
|
var headName = (isSxTruthy((typeOf(first(body)) == "symbol")) ? symbolName(first(body)) : (String(first(body))));
|
||||||
|
return (isSxTruthy((headName == "union")) ? cons("or", map(normalizeTypeBody, rest(body))) : cons(headName, map(normalizeTypeBody, rest(body))));
|
||||||
|
})()) : (String(body)))))))); };
|
||||||
|
PRIMITIVES["normalize-type-body"] = normalizeTypeBody;
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("deftype", function(args, env) { return (function() {
|
||||||
|
var nameOrForm = first(args);
|
||||||
|
var bodyExpr = nth(args, 1);
|
||||||
|
var typeName = NIL;
|
||||||
|
var typeParams = [];
|
||||||
|
(isSxTruthy((typeOf(nameOrForm) == "symbol")) ? (typeName = symbolName(nameOrForm)) : (isSxTruthy((typeOf(nameOrForm) == "list")) ? ((typeName = symbolName(first(nameOrForm))), (typeParams = map(function(p) { return (isSxTruthy((typeOf(p) == "symbol")) ? symbolName(p) : (String(p))); }, rest(nameOrForm)))) : NIL));
|
||||||
|
return (function() {
|
||||||
|
var body = normalizeTypeBody(bodyExpr);
|
||||||
|
var registry = (isSxTruthy(envHas(env, "*type-registry*")) ? envGet(env, "*type-registry*") : {});
|
||||||
|
registry[typeName] = {"name": typeName, "params": typeParams, "body": body};
|
||||||
|
envBind(env, "*type-registry*", registry);
|
||||||
|
return NIL;
|
||||||
|
})();
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// (register-special-form! ...)
|
||||||
|
registerSpecialForm("defeffect", function(args, env) { return (function() {
|
||||||
|
var effectName = (isSxTruthy((typeOf(first(args)) == "symbol")) ? symbolName(first(args)) : (String(first(args))));
|
||||||
|
var registry = (isSxTruthy(envHas(env, "*effect-registry*")) ? envGet(env, "*effect-registry*") : []);
|
||||||
|
if (isSxTruthy(!isSxTruthy(contains(registry, effectName)))) {
|
||||||
|
registry.push(effectName);
|
||||||
|
}
|
||||||
|
envBind(env, "*effect-registry*", registry);
|
||||||
|
return NIL;
|
||||||
|
})(); });
|
||||||
|
|
||||||
|
// WEB_FORM_NAMES
|
||||||
|
var WEB_FORM_NAMES = ["defhandler", "defpage", "defquery", "defaction", "defrelation", "defstyle", "deftype", "defeffect"];
|
||||||
|
PRIMITIVES["WEB_FORM_NAMES"] = WEB_FORM_NAMES;
|
||||||
|
|
||||||
|
|
||||||
// === Transpiled from parser ===
|
// === Transpiled from parser ===
|
||||||
|
|
||||||
// sx-parse
|
// sx-parse
|
||||||
|
|||||||
@@ -26,85 +26,10 @@
|
|||||||
|
|
||||||
|
|
||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
;; 0. Definition forms — deftype and defeffect
|
;; NOTE: deftype and defeffect definition forms have moved to web/web-forms.sx
|
||||||
|
;; (alongside defhandler, defpage, etc.) — they are domain forms, not core.
|
||||||
|
;; The type system below uses them but does not define them.
|
||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
;; These were previously in evaluator.sx. Now they live here and register
|
|
||||||
;; themselves via the custom special form mechanism.
|
|
||||||
|
|
||||||
(define make-type-def
|
|
||||||
(fn ((name :as string) (params :as list) body)
|
|
||||||
{:name name :params params :body body}))
|
|
||||||
|
|
||||||
(define normalize-type-body
|
|
||||||
(fn (body)
|
|
||||||
;; Convert AST type expressions to type representation.
|
|
||||||
;; Symbols → strings, (union ...) → (or ...), dict keys → strings.
|
|
||||||
(cond
|
|
||||||
(nil? body) "nil"
|
|
||||||
(= (type-of body) "symbol")
|
|
||||||
(symbol-name body)
|
|
||||||
(= (type-of body) "string")
|
|
||||||
body
|
|
||||||
(= (type-of body) "keyword")
|
|
||||||
(keyword-name body)
|
|
||||||
(= (type-of body) "dict")
|
|
||||||
;; Record type — normalize values
|
|
||||||
(map-dict (fn (k v) (normalize-type-body v)) body)
|
|
||||||
(= (type-of body) "list")
|
|
||||||
(if (empty? body) "any"
|
|
||||||
(let ((head (first body)))
|
|
||||||
(let ((head-name (if (= (type-of head) "symbol")
|
|
||||||
(symbol-name head) (str head))))
|
|
||||||
;; (union a b) → (or a b)
|
|
||||||
(if (= head-name "union")
|
|
||||||
(cons "or" (map normalize-type-body (rest body)))
|
|
||||||
;; (or a b), (list-of t), (-> ...) etc.
|
|
||||||
(cons head-name (map normalize-type-body (rest body)))))))
|
|
||||||
:else (str body))))
|
|
||||||
|
|
||||||
(define sf-deftype
|
|
||||||
(fn ((args :as list) (env :as dict))
|
|
||||||
;; (deftype name body) or (deftype (name a b ...) body)
|
|
||||||
(let ((name-or-form (first args))
|
|
||||||
(body-expr (nth args 1))
|
|
||||||
(type-name nil)
|
|
||||||
(type-params (list)))
|
|
||||||
;; Parse name — symbol or (symbol params...)
|
|
||||||
(if (= (type-of name-or-form) "symbol")
|
|
||||||
(set! type-name (symbol-name name-or-form))
|
|
||||||
(when (= (type-of name-or-form) "list")
|
|
||||||
(set! type-name (symbol-name (first name-or-form)))
|
|
||||||
(set! type-params
|
|
||||||
(map (fn (p) (if (= (type-of p) "symbol")
|
|
||||||
(symbol-name p) (str p)))
|
|
||||||
(rest name-or-form)))))
|
|
||||||
;; Normalize and store in *type-registry*
|
|
||||||
(let ((body (normalize-type-body body-expr))
|
|
||||||
(registry (if (env-has? env "*type-registry*")
|
|
||||||
(env-get env "*type-registry*")
|
|
||||||
(dict))))
|
|
||||||
(dict-set! registry type-name
|
|
||||||
(make-type-def type-name type-params body))
|
|
||||||
(env-bind! env "*type-registry*" registry)
|
|
||||||
nil))))
|
|
||||||
|
|
||||||
(define sf-defeffect
|
|
||||||
(fn ((args :as list) (env :as dict))
|
|
||||||
;; (defeffect name) — register an effect name
|
|
||||||
(let ((effect-name (if (= (type-of (first args)) "symbol")
|
|
||||||
(symbol-name (first args))
|
|
||||||
(str (first args))))
|
|
||||||
(registry (if (env-has? env "*effect-registry*")
|
|
||||||
(env-get env "*effect-registry*")
|
|
||||||
(list))))
|
|
||||||
(when (not (contains? registry effect-name))
|
|
||||||
(append! registry effect-name))
|
|
||||||
(env-bind! env "*effect-registry*" registry)
|
|
||||||
nil)))
|
|
||||||
|
|
||||||
;; Register as custom special forms
|
|
||||||
(register-special-form! "deftype" sf-deftype)
|
|
||||||
(register-special-form! "defeffect" sf-defeffect)
|
|
||||||
|
|
||||||
|
|
||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
|
|||||||
14
web/forms.sx
14
web/forms.sx
@@ -278,23 +278,11 @@
|
|||||||
(every? (fn (item) (= (type-of item) "dict")) data))))
|
(every? (fn (item) (= (type-of item) "dict")) data))))
|
||||||
|
|
||||||
|
|
||||||
;; --------------------------------------------------------------------------
|
|
||||||
;; defstyle — bind name to evaluated style expression
|
|
||||||
;; --------------------------------------------------------------------------
|
|
||||||
|
|
||||||
(define sf-defstyle
|
|
||||||
(fn ((args :as list) (env :as dict))
|
|
||||||
(let ((name-sym (first args))
|
|
||||||
(value (trampoline (eval-expr (nth args 1) env))))
|
|
||||||
(env-bind! env (symbol-name name-sym) value)
|
|
||||||
value)))
|
|
||||||
|
|
||||||
|
|
||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
;; Registration — make these available as special forms in the evaluator
|
;; Registration — make these available as special forms in the evaluator
|
||||||
|
;; NOTE: defstyle has moved to web/web-forms.sx
|
||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
(register-special-form! "defstyle" sf-defstyle)
|
|
||||||
(register-special-form! "defhandler" sf-defhandler)
|
(register-special-form! "defhandler" sf-defhandler)
|
||||||
(register-special-form! "defpage" sf-defpage)
|
(register-special-form! "defpage" sf-defpage)
|
||||||
(register-special-form! "defquery" sf-defquery)
|
(register-special-form! "defquery" sf-defquery)
|
||||||
|
|||||||
@@ -220,8 +220,88 @@
|
|||||||
;; survives spec reloads.
|
;; survives spec reloads.
|
||||||
;; --------------------------------------------------------------------------
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; defstyle — bind name to evaluated style expression
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(register-special-form! "defstyle"
|
||||||
|
(fn (args env)
|
||||||
|
(let ((name-sym (first args))
|
||||||
|
(value (trampoline (eval-expr (nth args 1) env))))
|
||||||
|
(env-bind! env (symbol-name name-sym) value)
|
||||||
|
value)))
|
||||||
|
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; deftype — register a named type alias / union / record
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(define normalize-type-body
|
||||||
|
(fn (body)
|
||||||
|
(cond
|
||||||
|
(nil? body) "nil"
|
||||||
|
(= (type-of body) "symbol")
|
||||||
|
(symbol-name body)
|
||||||
|
(= (type-of body) "string")
|
||||||
|
body
|
||||||
|
(= (type-of body) "keyword")
|
||||||
|
(keyword-name body)
|
||||||
|
(= (type-of body) "dict")
|
||||||
|
(map-dict (fn (k v) (normalize-type-body v)) body)
|
||||||
|
(= (type-of body) "list")
|
||||||
|
(if (empty? body) "any"
|
||||||
|
(let ((head-name (if (= (type-of (first body)) "symbol")
|
||||||
|
(symbol-name (first body)) (str (first body)))))
|
||||||
|
(if (= head-name "union")
|
||||||
|
(cons "or" (map normalize-type-body (rest body)))
|
||||||
|
(cons head-name (map normalize-type-body (rest body))))))
|
||||||
|
:else (str body))))
|
||||||
|
|
||||||
|
(register-special-form! "deftype"
|
||||||
|
(fn (args env)
|
||||||
|
(let ((name-or-form (first args))
|
||||||
|
(body-expr (nth args 1))
|
||||||
|
(type-name nil)
|
||||||
|
(type-params (list)))
|
||||||
|
(if (= (type-of name-or-form) "symbol")
|
||||||
|
(set! type-name (symbol-name name-or-form))
|
||||||
|
(when (= (type-of name-or-form) "list")
|
||||||
|
(set! type-name (symbol-name (first name-or-form)))
|
||||||
|
(set! type-params
|
||||||
|
(map (fn (p) (if (= (type-of p) "symbol")
|
||||||
|
(symbol-name p) (str p)))
|
||||||
|
(rest name-or-form)))))
|
||||||
|
(let ((body (normalize-type-body body-expr))
|
||||||
|
(registry (if (env-has? env "*type-registry*")
|
||||||
|
(env-get env "*type-registry*")
|
||||||
|
(dict))))
|
||||||
|
(dict-set! registry type-name
|
||||||
|
{:name type-name :params type-params :body body})
|
||||||
|
(env-bind! env "*type-registry*" registry)
|
||||||
|
nil))))
|
||||||
|
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; defeffect — register an effect name
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(register-special-form! "defeffect"
|
||||||
|
(fn (args env)
|
||||||
|
(let ((effect-name (if (= (type-of (first args)) "symbol")
|
||||||
|
(symbol-name (first args))
|
||||||
|
(str (first args))))
|
||||||
|
(registry (if (env-has? env "*effect-registry*")
|
||||||
|
(env-get env "*effect-registry*")
|
||||||
|
(list))))
|
||||||
|
(when (not (contains? registry effect-name))
|
||||||
|
(append! registry effect-name))
|
||||||
|
(env-bind! env "*effect-registry*" registry)
|
||||||
|
nil)))
|
||||||
|
|
||||||
|
|
||||||
(define WEB_FORM_NAMES
|
(define WEB_FORM_NAMES
|
||||||
(list "defhandler" "defpage" "defquery" "defaction" "defrelation"))
|
(list "defhandler" "defpage" "defquery" "defaction" "defrelation"
|
||||||
|
"defstyle" "deftype" "defeffect"))
|
||||||
|
|
||||||
;; Extend definition-form? via the stable extension point in render.sx
|
;; Extend definition-form? via the stable extension point in render.sx
|
||||||
(for-each (fn (name)
|
(for-each (fn (name)
|
||||||
|
|||||||
Reference in New Issue
Block a user