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

Move defstyle/deftype/defeffect to web-forms.sx — domain forms, not core

Browse Source 
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:
giles
2026-03-24 12:22:08 +00:00
parent 9caf8b6e94
commit 26e16f6aa4
6 changed files with 253 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
web/forms.sx
View File

@@ -278,23 +278,11 @@
(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
;; NOTE: defstyle has moved to web/web-forms.sx
;; --------------------------------------------------------------------------
(register-special-form! "defstyle" sf-defstyle)
(register-special-form! "defhandler" sf-defhandler)
(register-special-form! "defpage" sf-defpage)
(register-special-form! "defquery" sf-defquery)

82
web/web-forms.sx
View File

@@ -220,8 +220,88 @@
;; 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
(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
(for-each (fn (name)