From 67d2f325129a78c534faf3b41da14d31fcc33b31 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 8 Apr 2026 21:25:23 +0000 Subject: [PATCH] Fix type-check-strict compiler match + deploy HS to WASM - Compiler match for type-check-strict was still using old name type-check! - Deploy updated HS source files to shared/static/wasm/sx/ - Sandbox runner validates 16/16 hard cases pass with cek-eval (no runtime let-binding hacks needed in WASM context) Co-Authored-By: Claude Opus 4.6 (1M context) --- lib/hyperscript/compiler.sx | 2 +- shared/static/wasm/sx/hs-compiler.sx | 629 ++++++++++++++ shared/static/wasm/sx/hs-parser.sx | 1123 +++++++++++++++++++++++++ shared/static/wasm/sx/hs-runtime.sx | 41 +- shared/static/wasm/sx/hs-tokenizer.sx | 552 ++++++++++++ 5 files changed, 2341 insertions(+), 6 deletions(-) create mode 100644 shared/static/wasm/sx/hs-compiler.sx create mode 100644 shared/static/wasm/sx/hs-parser.sx create mode 100644 shared/static/wasm/sx/hs-tokenizer.sx diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index fcdf7846..7185041c 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -597,7 +597,7 @@ (quote hs-type-check) (hs-to-sx (nth ast 1)) (nth ast 2))) - ((= head (quote type-check!)) + ((= head (quote type-check-strict)) (list (quote hs-type-check-strict) (hs-to-sx (nth ast 1)) diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx new file mode 100644 index 00000000..7185041c --- /dev/null +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -0,0 +1,629 @@ +;; _hyperscript compiler — AST → SX expressions +;; +;; Input: AST from hs-parse (list structures) +;; Output: SX expressions targeting web/lib/dom.sx primitives +;; +;; Usage: +;; (hs-to-sx (hs-compile "on click add .active to me")) +;; → (hs-on me "click" (fn (event) (dom-add-class me "active"))) + +(define + hs-to-sx + (let + ((dot-sym (make-symbol ".")) (pct-sym (make-symbol "%"))) + (define emit-target (fn (ast) (hs-to-sx ast))) + (define + emit-set + (fn + (target value) + (if + (not (list? target)) + (list (quote set!) target value) + (let + ((th (first target))) + (cond + ((= th dot-sym) + (list + (quote dom-set-prop) + (hs-to-sx (nth target 1)) + (nth target 2) + value)) + ((= th (quote attr)) + (list + (quote dom-set-attr) + (hs-to-sx (nth target 2)) + (nth target 1) + value)) + ((= th (quote style)) + (list + (quote dom-set-style) + (hs-to-sx (nth target 2)) + (nth target 1) + value)) + ((= th (quote ref)) + (list (quote set!) (make-symbol (nth target 1)) value)) + ((= th (quote local)) + (list (quote set!) (make-symbol (nth target 1)) value)) + ((= th (quote me)) + (list (quote dom-set-inner-html) (quote me) value)) + ((= th (quote it)) (list (quote set!) (quote it) value)) + (true (list (quote set!) (hs-to-sx target) value))))))) + (define + emit-on + (fn + (ast) + (let + ((parts (rest ast))) + (let + ((event-name (first parts))) + (define + scan-on + (fn + (items source filter every?) + (cond + ((<= (len items) 1) + (let + ((body (if (> (len items) 0) (first items) nil))) + (let + ((target (if source (hs-to-sx source) (quote me)))) + (let + ((handler (list (quote fn) (list (quote event)) (hs-to-sx body)))) + (if + every? + (list + (quote hs-on-every) + target + event-name + handler) + (list (quote hs-on) target event-name handler)))))) + ((= (first items) :from) + (scan-on + (rest (rest items)) + (nth items 1) + filter + every?)) + ((= (first items) :filter) + (scan-on + (rest (rest items)) + source + (nth items 1) + every?)) + ((= (first items) :every) + (scan-on (rest (rest items)) source filter true)) + (true (scan-on (rest items) source filter every?))))) + (scan-on (rest parts) nil nil false))))) + (define + emit-send + (fn + (ast) + (let + ((name (nth ast 1)) (rest-parts (rest (rest ast)))) + (cond + ((and (= (len ast) 4) (list? (nth ast 2)) (= (first (nth ast 2)) (quote dict))) + (list + (quote dom-dispatch) + (hs-to-sx (nth ast 3)) + name + (hs-to-sx (nth ast 2)))) + ((= (len ast) 3) + (list (quote dom-dispatch) (hs-to-sx (nth ast 2)) name nil)) + (true (list (quote dom-dispatch) (quote me) name nil)))))) + (define + emit-repeat + (fn + (ast) + (let + ((mode (nth ast 1)) (body (hs-to-sx (nth ast 2)))) + (cond + ((and (list? mode) (= (first mode) (quote forever))) + (list + (quote hs-repeat-forever) + (list (quote fn) (list) body))) + ((and (list? mode) (= (first mode) (quote times))) + (list + (quote hs-repeat-times) + (hs-to-sx (nth mode 1)) + (list (quote fn) (list) body))) + ((number? mode) + (list + (quote hs-repeat-times) + mode + (list (quote fn) (list) body))) + (true + (list + (quote hs-repeat-times) + (hs-to-sx mode) + (list (quote fn) (list) body))))))) + (define + emit-for + (fn + (ast) + (let + ((var-name (nth ast 1)) + (collection (hs-to-sx (nth ast 2))) + (body (hs-to-sx (nth ast 3)))) + (if + (and (> (len ast) 4) (= (nth ast 4) :index)) + (list + (quote for-each) + (list + (quote fn) + (list (make-symbol var-name) (make-symbol (nth ast 5))) + body) + collection) + (list + (quote for-each) + (list (quote fn) (list (make-symbol var-name)) body) + collection))))) + (define + emit-wait-for + (fn + (ast) + (let + ((event-name (nth ast 1))) + (if + (and (> (len ast) 2) (= (nth ast 2) :from)) + (list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name) + (list (quote hs-wait-for) (quote me) event-name))))) + (define + emit-transition + (fn + (ast) + (let + ((prop (nth ast 1)) (value (hs-to-sx (nth ast 2)))) + (if + (= (len ast) 5) + (list + (quote hs-transition) + (hs-to-sx (nth ast 4)) + prop + value + (nth ast 3)) + (list + (quote hs-transition) + (hs-to-sx (nth ast 3)) + prop + value + nil))))) + (define + emit-make + (fn + (ast) + (if + (= (len ast) 3) + (list + (quote let) + (list + (list + (make-symbol (nth ast 2)) + (list (quote hs-make) (nth ast 1)))) + (make-symbol (nth ast 2))) + (list (quote hs-make) (nth ast 1))))) + (define + emit-inc + (fn + (expr tgt-override) + (let + ((t (hs-to-sx expr))) + (if + (and (list? expr) (= (first expr) (quote attr))) + (let + ((el (if tgt-override (hs-to-sx tgt-override) (hs-to-sx (nth expr 2))))) + (list + (quote dom-set-attr) + el + (nth expr 1) + (list + (quote +) + (list + (quote parse-number) + (list (quote dom-get-attr) el (nth expr 1))) + 1))) + (list (quote set!) t (list (quote +) t 1)))))) + (define + emit-dec + (fn + (expr tgt-override) + (let + ((t (hs-to-sx expr))) + (if + (and (list? expr) (= (first expr) (quote attr))) + (let + ((el (if tgt-override (hs-to-sx tgt-override) (hs-to-sx (nth expr 2))))) + (list + (quote dom-set-attr) + el + (nth expr 1) + (list + (quote -) + (list + (quote parse-number) + (list (quote dom-get-attr) el (nth expr 1))) + 1))) + (list (quote set!) t (list (quote -) t 1)))))) + (define + emit-behavior + (fn + (ast) + (let + ((name (nth ast 1)) (params (nth ast 2)) (body (nth ast 3))) + (list + (quote define) + (make-symbol name) + (list + (quote fn) + (cons (quote me) (map make-symbol params)) + (cons (quote do) (map hs-to-sx body))))))) + (fn + (ast) + (cond + ((nil? ast) nil) + ((number? ast) ast) + ((string? ast) ast) + ((boolean? ast) ast) + ((not (list? ast)) ast) + (true + (let + ((head (first ast))) + (cond + ((= head (quote null-literal)) nil) + ((= head (quote me)) (quote me)) + ((= head (quote it)) (quote it)) + ((= head (quote event)) (quote event)) + ((= head dot-sym) + (let + ((target (hs-to-sx (nth ast 1))) (prop (nth ast 2))) + (cond + ((= prop "first") (list (quote hs-first) target)) + ((= prop "last") (list (quote hs-last) target)) + (true (list (quote get) target prop))))) + ((= head (quote ref)) (make-symbol (nth ast 1))) + ((= head (quote query)) + (list (quote dom-query) (nth ast 1))) + ((= head (quote attr)) + (list + (quote dom-get-attr) + (hs-to-sx (nth ast 2)) + (nth ast 1))) + ((= head (quote style)) + (list + (quote dom-get-style) + (hs-to-sx (nth ast 2)) + (nth ast 1))) + ((= head (quote local)) (make-symbol (nth ast 1))) + ((= head (quote array)) + (cons (quote list) (map hs-to-sx (rest ast)))) + ((= head (quote not)) + (list (quote not) (hs-to-sx (nth ast 1)))) + ((= head (quote no)) + (list (quote hs-falsy?) (hs-to-sx (nth ast 1)))) + ((= head (quote and)) + (list + (quote and) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote or)) + (list + (quote or) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote =)) + (list + (quote =) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote +)) + (list + (quote hs-add) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote -)) + (list + (quote -) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote *)) + (list + (quote *) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote /)) + (list + (quote /) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head pct-sym) + (list + (quote modulo) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote empty?)) + (list (quote hs-empty?) (hs-to-sx (nth ast 1)))) + ((= head (quote exists?)) + (list + (quote not) + (list (quote nil?) (hs-to-sx (nth ast 1))))) + ((= head (quote matches?)) + (list + (quote hs-matches?) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote hs-contains?)) + (list + (quote hs-contains?) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote as)) + (list (quote hs-coerce) (hs-to-sx (nth ast 1)) (nth ast 2))) + ((= head (quote in?)) + (list + (quote hs-contains?) + (hs-to-sx (nth ast 2)) + (hs-to-sx (nth ast 1)))) + ((= head (quote of)) + (let + ((prop (hs-to-sx (nth ast 1))) + (target (hs-to-sx (nth ast 2)))) + (cond + ((= prop (quote first)) (list (quote first) target)) + ((= prop (quote last)) (list (quote last) target)) + (true (list (quote get) target prop))))) + ((= head "!=") + (list + (quote not) + (list + (quote =) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2))))) + ((= head "<") + (list + (quote <) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head ">") + (list + (quote >) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head "<=") + (list + (quote <=) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head ">=") + (list + (quote >=) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote closest)) + (list + (quote dom-closest) + (hs-to-sx (nth ast 2)) + (nth ast 1))) + ((= head (quote next)) + (list (quote hs-next) (hs-to-sx (nth ast 2)) (nth ast 1))) + ((= head (quote previous)) + (list + (quote hs-previous) + (hs-to-sx (nth ast 2)) + (nth ast 1))) + ((= head (quote first)) + (if + (> (len ast) 2) + (list + (quote hs-first) + (hs-to-sx (nth ast 2)) + (nth ast 1)) + (list (quote hs-query-first) (nth ast 1)))) + ((= head (quote last)) + (if + (> (len ast) 2) + (list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1)) + (list (quote hs-query-last) (nth ast 1)))) + ((= head (quote add-class)) + (list + (quote dom-add-class) + (hs-to-sx (nth ast 2)) + (nth ast 1))) + ((= head (quote remove-class)) + (list + (quote dom-remove-class) + (hs-to-sx (nth ast 2)) + (nth ast 1))) + ((= head (quote toggle-class)) + (list + (quote hs-toggle-class!) + (hs-to-sx (nth ast 2)) + (nth ast 1))) + ((= head (quote toggle-between)) + (list + (quote hs-toggle-between!) + (hs-to-sx (nth ast 3)) + (nth ast 1) + (nth ast 2))) + ((= head (quote set!)) + (emit-set (nth ast 1) (hs-to-sx (nth ast 2)))) + ((= head (quote put!)) + (list + (quote hs-put!) + (hs-to-sx (nth ast 1)) + (nth ast 2) + (hs-to-sx (nth ast 3)))) + ((= head (quote if)) + (if + (> (len ast) 3) + (list + (quote if) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)) + (hs-to-sx (nth ast 3))) + (list + (quote when) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2))))) + ((= head (quote do)) + (cons (quote do) (map hs-to-sx (rest ast)))) + ((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) + ((= head (quote wait-for)) (emit-wait-for ast)) + ((= head (quote log)) + (list (quote log) (hs-to-sx (nth ast 1)))) + ((= head (quote send)) (emit-send ast)) + ((= head (quote trigger)) + (list + (quote dom-dispatch) + (hs-to-sx (nth ast 2)) + (nth ast 1) + nil)) + ((= head (quote hide)) + (list + (quote dom-set-style) + (hs-to-sx (nth ast 1)) + "display" + "none")) + ((= head (quote show)) + (list + (quote dom-set-style) + (hs-to-sx (nth ast 1)) + "display" + "")) + ((= head (quote transition)) (emit-transition ast)) + ((= head (quote repeat)) (emit-repeat ast)) + ((= head (quote fetch)) + (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2))) + ((= head (quote call)) + (cons + (make-symbol (nth ast 1)) + (map hs-to-sx (rest (rest ast))))) + ((= head (quote return)) (hs-to-sx (nth ast 1))) + ((= head (quote throw)) + (list (quote raise) (hs-to-sx (nth ast 1)))) + ((= head (quote settle)) + (list (quote hs-settle) (quote me))) + ((= head (quote go)) + (list (quote hs-navigate!) (hs-to-sx (nth ast 1)))) + ((= head (quote append!)) + (list + (quote dom-append) + (hs-to-sx (nth ast 2)) + (hs-to-sx (nth ast 1)))) + ((= head (quote tell)) + (list + (quote let) + (list (list (quote me) (hs-to-sx (nth ast 1)))) + (hs-to-sx (nth ast 2)))) + ((= head (quote for)) (emit-for ast)) + ((= head (quote take)) + (list (quote hs-take!) (hs-to-sx (nth ast 2)) (nth ast 1))) + ((= head (quote make)) (emit-make ast)) + ((= head (quote install)) + (cons (quote hs-install) (map hs-to-sx (rest ast)))) + ((= head (quote measure)) + (list (quote hs-measure) (hs-to-sx (nth ast 1)))) + ((= head (quote increment!)) + (emit-inc + (nth ast 1) + (if (> (len ast) 2) (nth ast 2) nil))) + ((= head (quote decrement!)) + (emit-dec + (nth ast 1) + (if (> (len ast) 2) (nth ast 2) nil))) + ((= head (quote on)) (emit-on ast)) + ((= head (quote init)) + (list + (quote hs-init) + (list (quote fn) (list) (hs-to-sx (nth ast 1))))) + ((= head (quote def)) + (list + (quote define) + (make-symbol (nth ast 1)) + (list + (quote fn) + (map make-symbol (nth ast 2)) + (hs-to-sx (nth ast 3))))) + ((= head (quote behavior)) (emit-behavior ast)) + ((= head (quote sx-eval)) + (let + ((src (nth ast 1))) + (if + (string? src) + (first (sx-parse src)) + (list (quote cek-eval) (hs-to-sx src))))) + ((= head (quote component)) (make-symbol (nth ast 1))) + ((= head (quote render)) + (let + ((comp-raw (nth ast 1)) + (kwargs (nth ast 2)) + (pos (if (> (len ast) 3) (nth ast 3) nil)) + (target + (if (> (len ast) 4) (hs-to-sx (nth ast 4)) nil))) + (let + ((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw)))) + (define + emit-kw-pairs + (fn + (pairs) + (if + (< (len pairs) 2) + (list) + (cons + (make-keyword (first pairs)) + (cons + (hs-to-sx (nth pairs 1)) + (emit-kw-pairs (rest (rest pairs)))))))) + (let + ((render-call (cons (quote render-to-html) (cons comp (emit-kw-pairs kwargs))))) + (if + pos + (list + (quote hs-put!) + render-call + pos + (if target target (quote me))) + render-call))))) + ((= head (quote not-in?)) + (list + (quote not) + (list + (quote hs-contains?) + (hs-to-sx (nth ast 2)) + (hs-to-sx (nth ast 1))))) + ((= head (quote in?)) + (list + (quote hs-contains?) + (hs-to-sx (nth ast 2)) + (hs-to-sx (nth ast 1)))) + ((= head (quote type-check)) + (list + (quote hs-type-check) + (hs-to-sx (nth ast 1)) + (nth ast 2))) + ((= head (quote type-check-strict)) + (list + (quote hs-type-check-strict) + (hs-to-sx (nth ast 1)) + (nth ast 2))) + ((= head (quote strict-eq)) + (list + (quote hs-strict-eq) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)))) + ((= head (quote some)) + (list + (quote some) + (list + (quote fn) + (list (make-symbol (nth ast 1))) + (hs-to-sx (nth ast 3))) + (hs-to-sx (nth ast 2)))) + ((= head (quote every)) + (list + (quote every?) + (list + (quote fn) + (list (make-symbol (nth ast 1))) + (hs-to-sx (nth ast 3))) + (hs-to-sx (nth ast 2)))) + (true ast)))))))) + +;; ── Convenience: source → SX ───────────────────────────────── +(define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src)))) \ No newline at end of file diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx new file mode 100644 index 00000000..c3f1b640 --- /dev/null +++ b/shared/static/wasm/sx/hs-parser.sx @@ -0,0 +1,1123 @@ +;; _hyperscript parser — token stream → SX AST +;; +;; Input: list of {:type T :value V :pos P} tokens from hs-tokenize +;; Output: SX AST forms that map to runtime primitives + +;; ── Parser entry point ──────────────────────────────────────────── +(define + hs-parse + (fn + (tokens src) + (let + ((p 0) (tok-len (len tokens))) + (define tp (fn () (if (< p tok-len) (nth tokens p) nil))) + (define + tp-type + (fn () (let ((t (tp))) (if t (get t "type") "eof")))) + (define + tp-val + (fn () (let ((t (tp))) (if t (get t "value") nil)))) + (define + adv! + (fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t))) + (define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof")))) + (define + match-kw + (fn + (kw) + (if + (and (= (tp-type) "keyword") (= (tp-val) kw)) + (do (adv!) true) + nil))) + (define + expect-kw! + (fn + (kw) + (if + (match-kw kw) + true + (error (str "Expected '" kw "' at position " p))))) + (define + parse-dur + (fn + (val) + (let + ((slen (len val))) + (cond + ((and (>= slen 3) (= (substring val (- slen 2) slen) "ms")) + (parse-number (substring val 0 (- slen 2)))) + ((and (>= slen 2) (= (nth val (- slen 1)) "s")) + (* 1000 (parse-number (substring val 0 (- slen 1))))) + (true (parse-number val)))))) + (define + parse-poss-tail + (fn + (owner) + (let + ((typ (tp-type)) (val (tp-val))) + (cond + ((or (= typ "ident") (= typ "keyword")) + (do (adv!) (parse-prop-chain (list (quote .) owner val)))) + ((= typ "attr") (do (adv!) (list (quote attr) val owner))) + ((= typ "class") + (let + ((prop (get (adv!) "value"))) + (parse-prop-chain (list (quote .) owner prop)))) + (true owner))))) + (define + parse-prop-chain + (fn + (base) + (if + (and (= (tp-type) "class") (not (at-end?))) + (let + ((prop (get (adv!) "value"))) + (parse-prop-chain (list (quote .) base prop))) + base))) + (define + parse-trav + (fn + (kind) + (let + ((typ (tp-type)) (val (tp-val))) + (cond + ((= typ "selector") + (do (adv!) (list kind val (list (quote me))))) + ((= typ "class") + (do (adv!) (list kind (str "." val) (list (quote me))))) + ((= typ "id") + (do (adv!) (list kind (str "#" val) (list (quote me))))) + (true (list kind "*" (list (quote me)))))))) + (define + parse-pos-kw + (fn + (kind) + (let + ((typ (tp-type)) (val (tp-val))) + (let + ((sel (cond ((= typ "selector") (do (adv!) val)) ((= typ "class") (do (adv!) (str "." val))) ((= typ "id") (do (adv!) (str "#" val))) (true "*")))) + (if + (match-kw "in") + (list kind sel (parse-expr)) + (list kind sel)))))) + (define + parse-atom + (fn + () + (let + ((typ (tp-type)) (val (tp-val))) + (cond + ((= typ "number") (do (adv!) (parse-dur val))) + ((= typ "string") (do (adv!) val)) + ((and (= typ "keyword") (= val "true")) (do (adv!) true)) + ((and (= typ "keyword") (= val "false")) (do (adv!) false)) + ((and (= typ "keyword") (or (= val "null") (= val "nil"))) + (do (adv!) (list (quote null-literal)))) + ((and (= typ "keyword") (= val "undefined")) + (do (adv!) (list (quote null-literal)))) + ((and (= typ "keyword") (= val "not")) + (do (adv!) (list (quote not) (parse-expr)))) + ((and (= typ "keyword") (= val "no")) + (do (adv!) (list (quote no) (parse-expr)))) + ((and (= typ "keyword") (= val "eval")) + (do + (adv!) + (if + (= (tp-type) "paren-open") + (list (quote sx-eval) (collect-sx-source)) + (list (quote sx-eval) (parse-expr))))) + ((and (= typ "keyword") (= val "the")) + (do (adv!) (parse-the-expr))) + ((and (= typ "keyword") (= val "me")) + (do (adv!) (list (quote me)))) + ((and (= typ "keyword") (= val "I")) + (do (adv!) (list (quote me)))) + ((and (= typ "keyword") (or (= val "it") (= val "result"))) + (do (adv!) (list (quote it)))) + ((and (= typ "keyword") (= val "event")) + (do (adv!) (list (quote event)))) + ((and (= typ "keyword") (= val "target")) + (do + (adv!) + (list (make-symbol ".") (list (quote event)) "target"))) + ((and (= typ "keyword") (= val "detail")) + (do + (adv!) + (list (make-symbol ".") (list (quote event)) "detail"))) + ((and (= typ "keyword") (= val "my")) + (do (adv!) (parse-poss-tail (list (quote me))))) + ((and (= typ "keyword") (= val "its")) + (do (adv!) (parse-poss-tail (list (quote it))))) + ((and (= typ "keyword") (= val "closest")) + (do (adv!) (parse-trav (quote closest)))) + ((and (= typ "keyword") (= val "next")) + (do (adv!) (parse-trav (quote next)))) + ((and (= typ "keyword") (= val "previous")) + (do (adv!) (parse-trav (quote previous)))) + ((and (= typ "keyword") (= val "first")) + (do (adv!) (parse-pos-kw (quote first)))) + ((and (= typ "keyword") (= val "last")) + (do (adv!) (parse-pos-kw (quote last)))) + ((= typ "id") + (do (adv!) (list (quote query) (str "#" val)))) + ((= typ "selector") (do (adv!) (list (quote query) val))) + ((= typ "attr") + (do (adv!) (list (quote attr) val (list (quote me))))) + ((= typ "style") + (do (adv!) (list (quote style) val (list (quote me))))) + ((= typ "local") (do (adv!) (list (quote local) val))) + ((= typ "class") (do (adv!) (str "." val))) + ((= typ "ident") (do (adv!) (list (quote ref) val))) + ((= typ "paren-open") + (do + (adv!) + (let + ((expr (parse-expr))) + (if (= (tp-type) "paren-close") (adv!) nil) + expr))) + ((= typ "bracket-open") (do (adv!) (parse-array-lit))) + ((and (= typ "op") (= val "-")) + (do + (adv!) + (let + ((operand (parse-atom))) + (list (quote -) 0 operand)))) + ((= typ "component") + (do (adv!) (list (quote component) val))) + ((and (= typ "keyword") (= val "some")) + (do + (adv!) + (if + (and + (= (tp-type) "ident") + (> (len tokens) (+ p 1)) + (= (get (nth tokens (+ p 1)) "value") "in")) + (let + ((var-name (tp-val))) + (do + (adv!) + (match-kw "in") + (let + ((collection (parse-expr))) + (do + (match-kw "with") + (list + (quote some) + var-name + collection + (parse-expr)))))) + (list (quote not) (list (quote no) (parse-expr)))))) + ((and (= typ "keyword") (= val "every")) + (do + (adv!) + (let + ((var-name (tp-val))) + (do + (adv!) + (match-kw "in") + (let + ((collection (parse-expr))) + (do + (match-kw "with") + (list + (quote every) + var-name + collection + (parse-expr)))))))) + (true nil))))) + (define + parse-poss + (fn + (obj) + (cond + ((and (= (tp-type) "op") (= (tp-val) "'s")) + (do (adv!) (parse-poss-tail obj))) + ((= (tp-type) "class") (parse-prop-chain obj)) + (true obj)))) + (define + parse-cmp + (fn + (left) + (let + ((typ (tp-type)) (val (tp-val))) + (cond + ((and (= typ "op") (or (= val "==") (= val "!=") (= val "<") (= val ">") (= val "<=") (= val ">=") (= val "===") (= val "!=="))) + (do + (adv!) + (let + ((right (parse-expr))) + (cond + ((= val "==") (list (quote =) left right)) + ((= val "===") (list (quote strict-eq) left right)) + ((= val "!==") + (list + (quote not) + (list (quote strict-eq) left right))) + (true (list val left right)))))) + ((and (= typ "keyword") (= val "is")) + (do + (adv!) + (cond + ((match-kw "not") + (cond + ((match-kw "empty") + (list (quote not) (list (quote empty?) left))) + ((match-kw "in") + (list (quote not-in?) left (parse-expr))) + ((match-kw "really") + (do + (match-kw "equal") + (match-kw "to") + (list + (quote not) + (list (quote strict-eq) left (parse-expr))))) + ((match-kw "equal") + (do + (match-kw "to") + (list + (quote not) + (list (quote =) left (parse-expr))))) + ((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true))) + (let + ((type-name (tp-val))) + (do + (adv!) + (let + ((strict (and (= (tp-type) "op") (= (tp-val) "!")))) + (when strict (adv!)) + (if + strict + (list + (quote not) + (list + (quote type-check-strict) + left + type-name)) + (list + (quote not) + (list (quote type-check) left type-name))))))) + (true + (let + ((right (parse-expr))) + (list (quote not) (list (quote =) left right)))))) + ((match-kw "empty") (list (quote empty?) left)) + ((match-kw "less") + (do + (match-kw "than") + (if + (match-kw "or") + (do + (match-kw "equal") + (match-kw "to") + (list (quote <=) left (parse-expr))) + (list (quote <) left (parse-expr))))) + ((match-kw "greater") + (do + (match-kw "than") + (if + (match-kw "or") + (do + (match-kw "equal") + (match-kw "to") + (list (quote >=) left (parse-expr))) + (list (quote >) left (parse-expr))))) + ((match-kw "in") (list (quote in?) left (parse-expr))) + ((match-kw "really") + (do + (match-kw "equal") + (match-kw "to") + (list (quote strict-eq) left (parse-expr)))) + ((match-kw "equal") + (do + (match-kw "to") + (list (quote =) left (parse-expr)))) + ((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true))) + (let + ((type-name (tp-val))) + (do + (adv!) + (let + ((strict (and (= (tp-type) "op") (= (tp-val) "!")))) + (when strict (adv!)) + (if + strict + (list (quote type-check-strict) left type-name) + (list (quote type-check) left type-name)))))) + (true + (let + ((right (parse-expr))) + (list (quote =) left right)))))) + ((and (= typ "keyword") (= val "am")) + (do + (adv!) + (cond + ((match-kw "not") + (cond + ((match-kw "in") + (list (quote not-in?) left (parse-expr))) + ((match-kw "empty") + (list (quote not) (list (quote empty?) left))) + (true + (let + ((right (parse-expr))) + (list (quote not) (list (quote =) left right)))))) + ((match-kw "in") (list (quote in?) left (parse-expr))) + ((match-kw "empty") (list (quote empty?) left)) + (true + (let + ((right (parse-expr))) + (list (quote =) left right)))))) + ((and (= typ "keyword") (= val "exists")) + (do (adv!) (list (quote exists?) left))) + ((and (= typ "keyword") (= val "matches")) + (do (adv!) (list (quote matches?) left (parse-expr)))) + ((and (= typ "keyword") (= val "contains")) + (do (adv!) (list (quote contains?) left (parse-expr)))) + ((and (= typ "keyword") (= val "and")) + (do (adv!) (list (quote and) left (parse-expr)))) + ((and (= typ "keyword") (= val "or")) + (do (adv!) (list (quote or) left (parse-expr)))) + ((and (= typ "keyword") (= val "as")) + (do + (adv!) + (let + ((type-name (tp-val))) + (adv!) + (list (quote as) left type-name)))) + ((and (= typ "keyword") (= val "of")) + (do + (adv!) + (let + ((target (parse-expr))) + (if + (and (list? left) (= (first left) (quote ref))) + (list (make-symbol ".") target (nth left 1)) + (list (quote of) left target))))) + ((and (= typ "keyword") (= val "in")) + (do (adv!) (list (quote in?) left (parse-expr)))) + ((and (= typ "keyword") (= val "does")) + (do + (adv!) + (match-kw "not") + (cond + ((match-kw "exist") + (list (quote not) (list (quote exists?) left))) + ((match-kw "match") + (list + (quote not) + (list (quote matches?) left (parse-expr)))) + ((or (match-kw "contain") (match-kw "contains")) + (list + (quote not) + (list (quote contains?) left (parse-expr)))) + ((or (match-kw "include") (match-kw "includes")) + (list + (quote not) + (list (quote contains?) left (parse-expr)))) + (true left)))) + ((and (= typ "keyword") (= val "equals")) + (do (adv!) (list (quote =) left (parse-expr)))) + ((and (= typ "keyword") (= val "really")) + (do + (adv!) + (match-kw "equals") + (list (quote strict-eq) left (parse-expr)))) + ((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes"))) + (do (adv!) (list (quote contains?) left (parse-expr)))) + (true left))))) + (define + parse-expr + (fn + () + (let + ((left (parse-atom))) + (if + (nil? left) + nil + (let + ((left2 (parse-poss left))) + (let ((left3 (parse-arith left2))) (parse-cmp left3))))))) + (define + parse-tgt-kw + (fn (kw default) (if (match-kw kw) (parse-expr) default))) + (define + parse-add-cmd + (fn + () + (if + (= (tp-type) "class") + (let + ((cls (get (adv!) "value"))) + (let + ((tgt (parse-tgt-kw "to" (list (quote me))))) + (list (quote add-class) cls tgt))) + nil))) + (define + parse-remove-cmd + (fn + () + (if + (= (tp-type) "class") + (let + ((cls (get (adv!) "value"))) + (let + ((tgt (parse-tgt-kw "from" (list (quote me))))) + (list (quote remove-class) cls tgt))) + nil))) + (define + parse-toggle-cmd + (fn + () + (cond + ((match-kw "between") + (if + (= (tp-type) "class") + (let + ((cls1 (get (adv!) "value"))) + (expect-kw! "and") + (if + (= (tp-type) "class") + (let + ((cls2 (get (adv!) "value"))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (list (quote toggle-between) cls1 cls2 tgt))) + nil)) + nil)) + ((= (tp-type) "class") + (let + ((cls (get (adv!) "value"))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (list (quote toggle-class) cls tgt)))) + (true nil)))) + (define + parse-set-cmd + (fn + () + (let + ((tgt (parse-expr))) + (expect-kw! "to") + (let ((value (parse-expr))) (list (quote set!) tgt value))))) + (define + parse-put-cmd + (fn + () + (let + ((value (parse-expr))) + (cond + ((match-kw "into") (list (quote set!) (parse-expr) value)) + ((match-kw "before") + (list (quote put!) value "before" (parse-expr))) + ((match-kw "after") + (list (quote put!) value "after" (parse-expr))) + (true + (error (str "Expected into/before/after at position " p))))))) + (define + parse-if-cmd + (fn + () + (let + ((cnd (parse-expr))) + (let + ((then-body (parse-cmd-list))) + (let + ((else-body (if (or (match-kw "else") (match-kw "otherwise")) (parse-cmd-list) nil))) + (match-kw "end") + (if + else-body + (list (quote if) cnd then-body else-body) + (list (quote if) cnd then-body))))))) + (define + parse-wait-cmd + (fn + () + (cond + ((match-kw "for") + (let + ((event-name (tp-val))) + (adv!) + (let + ((source (if (match-kw "from") (parse-expr) nil))) + (if + source + (list (quote wait-for) event-name :from source) + (list (quote wait-for) event-name))))) + ((= (tp-type) "number") + (let + ((tok (adv!))) + (list (quote wait) (parse-dur (get tok "value"))))) + (true (list (quote wait) 0))))) + (define + parse-detail-dict + (fn + () + (adv!) + (define + dd-collect + (fn + (acc) + (if + (or (= (tp-type) "paren-close") (at-end?)) + (do (if (= (tp-type) "paren-close") (adv!) nil) acc) + (let + ((key (get (adv!) "value"))) + (if (= (tp-type) "colon") (adv!) nil) + (let + ((val (parse-expr))) + (if (= (tp-type) "comma") (adv!) nil) + (dd-collect (append acc (list key val)))))))) + (cons (quote dict) (dd-collect (list))))) + (define + parse-send-cmd + (fn + () + (let + ((name (get (adv!) "value"))) + (let + ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) + (let + ((tgt (parse-tgt-kw "to" (list (quote me))))) + (if + dtl + (list (quote send) name dtl tgt) + (list (quote send) name tgt))))))) + (define + parse-trigger-cmd + (fn + () + (let + ((name (get (adv!) "value"))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (list (quote trigger) name tgt))))) + (define parse-log-cmd (fn () (list (quote log) (parse-expr)))) + (define + parse-inc-cmd + (fn + () + (let + ((expr (parse-expr))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (list (quote increment!) expr tgt))))) + (define + parse-dec-cmd + (fn + () + (let + ((expr (parse-expr))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (list (quote decrement!) expr tgt))))) + (define + parse-hide-cmd + (fn + () + (let + ((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me)))))) + (list (quote hide) tgt)))) + (define + parse-show-cmd + (fn + () + (let + ((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me)))))) + (list (quote show) tgt)))) + (define + parse-transition-cmd + (fn + () + (let + ((prop (get (adv!) "value"))) + (expect-kw! "to") + (let + ((value (parse-expr))) + (let + ((dur (if (match-kw "over") (if (= (tp-type) "number") (parse-dur (get (adv!) "value")) 400) nil))) + (let + ((tgt (parse-tgt-kw "on" (list (quote me))))) + (if + dur + (list (quote transition) prop value dur tgt) + (list (quote transition) prop value tgt)))))))) + (define + parse-repeat-cmd + (fn + () + (let + ((mode (cond ((match-kw "forever") (list (quote forever))) ((match-kw "while") (list (quote while) (parse-expr))) ((match-kw "until") (list (quote until) (parse-expr))) ((= (tp-type) "number") (let ((n (parse-dur (get (adv!) "value")))) (expect-kw! "times") (list (quote times) n))) (true (list (quote forever)))))) + (let + ((body (parse-cmd-list))) + (match-kw "end") + (list (quote repeat) mode body))))) + (define + parse-fetch-cmd + (fn + () + (let + ((url-atom (parse-atom))) + (let + ((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom))))) + (let + ((fmt (if (match-kw "as") (let ((f (tp-val))) (adv!) f) "json"))) + (list (quote fetch) url fmt)))))) + (define + parse-call-args + (fn + () + (adv!) + (define + ca-collect + (fn + (acc) + (if + (or (= (tp-type) "paren-close") (at-end?)) + (do (if (= (tp-type) "paren-close") (adv!) nil) acc) + (let + ((arg (parse-expr))) + (if (= (tp-type) "comma") (adv!) nil) + (ca-collect (append acc (list arg))))))) + (ca-collect (list)))) + (define + parse-call-cmd + (fn + () + (let + ((name (get (adv!) "value"))) + (if + (= (tp-type) "paren-open") + (let + ((args (parse-call-args))) + (cons (quote call) (cons name args))) + (list (quote call) name))))) + (define + parse-take-cmd + (fn + () + (if + (= (tp-type) "class") + (let + ((cls (get (adv!) "value"))) + (let + ((tgt (parse-tgt-kw "from" (list (quote me))))) + (list (quote take) cls tgt))) + nil))) + (define + parse-go-cmd + (fn () (match-kw "to") (list (quote go) (parse-expr)))) + (define + parse-arith + (fn + (left) + (let + ((typ (tp-type)) (val (tp-val))) + (if + (or + (and + (= typ "op") + (or + (= val "+") + (= val "-") + (= val "*") + (= val "/") + (= val "%"))) + (and (= typ "keyword") (= val "mod"))) + (do + (adv!) + (let + ((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%"))))) + (let + ((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a))))) + (parse-arith (list op left right))))) + left)))) + (define + parse-the-expr + (fn + () + (let + ((typ (tp-type)) (val (tp-val))) + (if + (or (= typ "ident") (= typ "keyword")) + (do + (adv!) + (if + (match-kw "of") + (list (make-symbol ".") (parse-expr) val) + (cond + ((= val "result") (list (quote it))) + ((= val "first") (parse-pos-kw (quote first))) + ((= val "last") (parse-pos-kw (quote last))) + ((= val "closest") (parse-trav (quote closest))) + ((= val "next") (parse-trav (quote next))) + ((= val "previous") (parse-trav (quote previous))) + (true (list (quote ref) val))))) + (parse-atom))))) + (define + parse-array-lit + (fn + () + (define + al-collect + (fn + (acc) + (if + (or (= (tp-type) "bracket-close") (at-end?)) + (do (if (= (tp-type) "bracket-close") (adv!) nil) acc) + (let + ((elem (parse-expr))) + (if (= (tp-type) "comma") (adv!) nil) + (al-collect (append acc (list elem))))))) + (cons (quote array) (al-collect (list))))) + (define + parse-return-cmd + (fn + () + (if + (or + (at-end?) + (and + (= (tp-type) "keyword") + (or + (= (tp-val) "end") + (= (tp-val) "then") + (= (tp-val) "else")))) + (list (quote return) nil) + (list (quote return) (parse-expr))))) + (define parse-throw-cmd (fn () (list (quote throw) (parse-expr)))) + (define + parse-append-cmd + (fn + () + (let + ((value (parse-expr))) + (expect-kw! "to") + (let + ((target (parse-expr))) + (list (quote append!) value target))))) + (define + parse-tell-cmd + (fn + () + (let + ((target (parse-expr))) + (let + ((body (parse-cmd-list))) + (match-kw "end") + (list (quote tell) target body))))) + (define + parse-for-cmd + (fn + () + (let + ((var-name (tp-val))) + (adv!) + (expect-kw! "in") + (let + ((collection (parse-expr))) + (let + ((idx (if (match-kw "index") (let ((iname (tp-val))) (adv!) iname) nil))) + (let + ((body (parse-cmd-list))) + (match-kw "end") + (if + idx + (list (quote for) var-name collection body :index idx) + (list (quote for) var-name collection body)))))))) + (define + parse-make-cmd + (fn + () + (if (= (tp-val) "a") (adv!) nil) + (let + ((type-name (tp-val))) + (adv!) + (let + ((called (if (match-kw "called") (let ((n (tp-val))) (adv!) n) nil))) + (if + called + (list (quote make) type-name called) + (list (quote make) type-name)))))) + (define + parse-install-cmd + (fn + () + (let + ((name (tp-val))) + (adv!) + (if + (= (tp-type) "paren-open") + (let + ((args (parse-call-args))) + (cons (quote install) (cons name args))) + (list (quote install) name))))) + (define + parse-measure-cmd + (fn + () + (let + ((tgt (parse-expr))) + (list (quote measure) (if (nil? tgt) (list (quote me)) tgt))))) + (define + parse-param-list + (fn () (if (= (tp-type) "paren-open") (parse-call-args) (list)))) + (define + parse-feat-body + (fn + () + (define + fb-collect + (fn + (acc) + (if + (or + (at-end?) + (and (= (tp-type) "keyword") (= (tp-val) "end"))) + acc + (let + ((feat (parse-feat))) + (if + (nil? feat) + acc + (fb-collect (append acc (list feat)))))))) + (fb-collect (list)))) + (define + parse-def-feat + (fn + () + (let + ((name (tp-val))) + (adv!) + (let + ((params (parse-param-list))) + (let + ((body (parse-cmd-list))) + (match-kw "end") + (list (quote def) name params body)))))) + (define + parse-behavior-feat + (fn + () + (let + ((name (tp-val))) + (adv!) + (let + ((params (parse-param-list))) + (let + ((body (parse-feat-body))) + (match-kw "end") + (list (quote behavior) name params body)))))) + (define + parse-render-kwargs + (fn + () + (define + collect-kw + (fn + (acc) + (if + (= (tp-type) "local") + (let + ((key (tp-val))) + (adv!) + (let + ((val (parse-expr))) + (collect-kw (append acc (list key val))))) + acc))) + (collect-kw (list)))) + (define + parse-render-cmd + (fn + () + (let + ((comp (cond ((= (tp-type) "component") (let ((name (tp-val))) (adv!) name)) ((= (tp-type) "paren-open") (do (adv!) (let ((expr (parse-expr))) (if (= (tp-type) "paren-close") (adv!) nil) expr))) (true (let ((name (tp-val))) (adv!) name))))) + (let + ((kwargs (parse-render-kwargs))) + (let + ((pos (cond ((match-kw "into") "into") ((match-kw "before") "before") ((match-kw "after") "after") (true nil)))) + (let + ((target (if pos (parse-expr) nil))) + (if + pos + (list (quote render) comp kwargs pos target) + (list (quote render) comp kwargs)))))))) + (define + collect-sx-source + (fn + () + (let + ((start-pos (get (tp) "pos"))) + (adv!) + (define + skip-to-close + (fn + (depth) + (cond + ((at-end?) start-pos) + ((= (tp-type) "paren-open") + (do (adv!) (skip-to-close (+ depth 1)))) + ((= (tp-type) "paren-close") + (if + (= depth 0) + (let + ((end-pos (+ (get (tp) "pos") 1))) + (adv!) + end-pos) + (do (adv!) (skip-to-close (- depth 1))))) + (true (do (adv!) (skip-to-close depth)))))) + (let + ((end-pos (skip-to-close 0))) + (substring src start-pos end-pos))))) + (define + parse-cmd + (fn + () + (let + ((typ (tp-type)) (val (tp-val))) + (cond + ((and (= typ "keyword") (= val "add")) + (do (adv!) (parse-add-cmd))) + ((and (= typ "keyword") (= val "remove")) + (do (adv!) (parse-remove-cmd))) + ((and (= typ "keyword") (= val "toggle")) + (do (adv!) (parse-toggle-cmd))) + ((and (= typ "keyword") (= val "set")) + (do (adv!) (parse-set-cmd))) + ((and (= typ "keyword") (= val "put")) + (do (adv!) (parse-put-cmd))) + ((and (= typ "keyword") (= val "if")) + (do (adv!) (parse-if-cmd))) + ((and (= typ "keyword") (= val "wait")) + (do (adv!) (parse-wait-cmd))) + ((and (= typ "keyword") (= val "send")) + (do (adv!) (parse-send-cmd))) + ((and (= typ "keyword") (= val "trigger")) + (do (adv!) (parse-trigger-cmd))) + ((and (= typ "keyword") (= val "log")) + (do (adv!) (parse-log-cmd))) + ((and (= typ "keyword") (= val "increment")) + (do (adv!) (parse-inc-cmd))) + ((and (= typ "keyword") (= val "decrement")) + (do (adv!) (parse-dec-cmd))) + ((and (= typ "keyword") (= val "hide")) + (do (adv!) (parse-hide-cmd))) + ((and (= typ "keyword") (= val "show")) + (do (adv!) (parse-show-cmd))) + ((and (= typ "keyword") (= val "transition")) + (do (adv!) (parse-transition-cmd))) + ((and (= typ "keyword") (= val "repeat")) + (do (adv!) (parse-repeat-cmd))) + ((and (= typ "keyword") (= val "fetch")) + (do (adv!) (parse-fetch-cmd))) + ((and (= typ "keyword") (= val "call")) + (do (adv!) (parse-call-cmd))) + ((and (= typ "keyword") (= val "take")) + (do (adv!) (parse-take-cmd))) + ((and (= typ "keyword") (= val "settle")) + (do (adv!) (list (quote settle)))) + ((and (= typ "keyword") (= val "go")) + (do (adv!) (parse-go-cmd))) + ((and (= typ "keyword") (= val "return")) + (do (adv!) (parse-return-cmd))) + ((and (= typ "keyword") (= val "throw")) + (do (adv!) (parse-throw-cmd))) + ((and (= typ "keyword") (= val "append")) + (do (adv!) (parse-append-cmd))) + ((and (= typ "keyword") (= val "tell")) + (do (adv!) (parse-tell-cmd))) + ((and (= typ "keyword") (= val "for")) + (do (adv!) (parse-for-cmd))) + ((and (= typ "keyword") (= val "make")) + (do (adv!) (parse-make-cmd))) + ((and (= typ "keyword") (= val "install")) + (do (adv!) (parse-install-cmd))) + ((and (= typ "keyword") (= val "measure")) + (do (adv!) (parse-measure-cmd))) + ((and (= typ "keyword") (= val "render")) + (do (adv!) (parse-render-cmd))) + (true (parse-expr)))))) + (define + parse-cmd-list + (fn + () + (define + cl-collect + (fn + (acc) + (let + ((cmd (parse-cmd))) + (if + (nil? cmd) + acc + (let + ((acc2 (append acc (list cmd)))) + (if (match-kw "then") (cl-collect acc2) acc2)))))) + (let + ((cmds (cl-collect (list)))) + (cond + ((= (len cmds) 0) nil) + ((= (len cmds) 1) (first cmds)) + (true (cons (quote do) cmds)))))) + (define + parse-on-feat + (fn + () + (let + ((every? (match-kw "every"))) + (let + ((event-name (let ((v (tp-val))) (adv!) v))) + (let + ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) + (let + ((source (if (match-kw "from") (parse-expr) nil))) + (let + ((body (parse-cmd-list))) + (match-kw "end") + (let + ((parts (list (quote on) event-name))) + (let + ((parts (if every? (append parts (list :every true)) parts))) + (let + ((parts (if flt (append parts (list :filter flt)) parts))) + (let + ((parts (if source (append parts (list :from source)) parts))) + (append parts (list body))))))))))))) + (define + parse-init-feat + (fn + () + (let + ((body (parse-cmd-list))) + (match-kw "end") + (list (quote init) body)))) + (define + parse-feat + (fn + () + (let + ((val (tp-val))) + (cond + ((= val "on") (do (adv!) (parse-on-feat))) + ((= val "init") (do (adv!) (parse-init-feat))) + ((= val "def") (do (adv!) (parse-def-feat))) + ((= val "behavior") (do (adv!) (parse-behavior-feat))) + (true (parse-cmd-list)))))) + (define + coll-feats + (fn + (acc) + (if + (at-end?) + acc + (let + ((feat (parse-feat))) + (if (nil? feat) acc (coll-feats (append acc (list feat)))))))) + (let + ((features (coll-feats (list)))) + (if + (= (len features) 1) + (first features) + (cons (quote do) features)))))) + +;; ── Convenience: source string → AST ───────────────────────────── +(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src))) diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index c277c351..4796ac07 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -284,7 +284,7 @@ (true true))))) (define - hs-type-check! + hs-type-check-strict (fn (value type-name) (if (nil? value) false (hs-type-check value type-name)))) @@ -295,7 +295,15 @@ (define hs-falsy? - (fn (v) (or (nil? v) (= v false) (and (string? v) (= v ""))))) + (fn + (v) + (cond + ((nil? v) true) + ((= v false) true) + ((and (string? v) (= v "")) true) + ((and (list? v) (= (len v) 0)) true) + ((= v 0) true) + (true false)))) (define hs-matches? @@ -311,6 +319,29 @@ (fn (collection item) (cond - ((list? collection) (some (fn (x) (= x item)) collection)) - ((string? collection) (string-contains? collection item)) - (true false)))) \ No newline at end of file + ((nil? collection) false) + ((string? collection) (string-contains? collection (str item))) + ((list? collection) + (if + (= (len collection) 0) + false + (if + (= (first collection) item) + true + (hs-contains? (rest collection) item)))) + (true false)))) + +(define + hs-empty? + (fn + (v) + (cond + ((nil? v) true) + ((string? v) (= (len v) 0)) + ((list? v) (= (len v) 0)) + ((dict? v) (= (len (keys v)) 0)) + (true false)))) + +(define hs-first (fn (lst) (first lst))) + +(define hs-last (fn (lst) (last lst))) \ No newline at end of file diff --git a/shared/static/wasm/sx/hs-tokenizer.sx b/shared/static/wasm/sx/hs-tokenizer.sx new file mode 100644 index 00000000..44fe6fce --- /dev/null +++ b/shared/static/wasm/sx/hs-tokenizer.sx @@ -0,0 +1,552 @@ +;; _hyperscript tokenizer — produces token stream from hyperscript source +;; +;; Tokens: {:type T :value V :pos P} +;; Types: "keyword" "ident" "number" "string" "class" "id" "attr" "style" +;; "selector" "op" "dot" "paren-open" "paren-close" "bracket-open" +;; "bracket-close" "brace-open" "brace-close" "comma" "colon" +;; "template" "local" "eof" + +;; ── Token constructor ───────────────────────────────────────────── + +(define hs-make-token (fn (type value pos) {:pos pos :value value :type type})) + +;; ── Character predicates ────────────────────────────────────────── + +(define hs-digit? (fn (c) (and (>= c "0") (<= c "9")))) + +(define + hs-letter? + (fn (c) (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))) + +(define hs-ident-start? (fn (c) (or (hs-letter? c) (= c "_") (= c "$")))) + +(define + hs-ident-char? + (fn + (c) + (or (hs-letter? c) (hs-digit? c) (= c "_") (= c "$") (= c "-")))) + +(define hs-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r")))) + +;; ── Keyword set ─────────────────────────────────────────────────── + +(define + hs-keywords + (list + "on" + "end" + "set" + "to" + "put" + "into" + "before" + "after" + "add" + "remove" + "toggle" + "if" + "else" + "otherwise" + "then" + "from" + "in" + "of" + "for" + "until" + "wait" + "send" + "trigger" + "call" + "get" + "take" + "log" + "hide" + "show" + "repeat" + "while" + "times" + "forever" + "break" + "continue" + "return" + "throw" + "catch" + "finally" + "def" + "tell" + "make" + "fetch" + "as" + "with" + "every" + "or" + "and" + "not" + "is" + "no" + "the" + "my" + "me" + "it" + "its" + "result" + "true" + "false" + "null" + "when" + "between" + "at" + "by" + "queue" + "elsewhere" + "event" + "target" + "detail" + "sender" + "index" + "increment" + "decrement" + "append" + "settle" + "transition" + "over" + "closest" + "next" + "previous" + "first" + "last" + "random" + "empty" + "exists" + "matches" + "contains" + "do" + "unless" + "you" + "your" + "new" + "init" + "start" + "go" + "js" + "less" + "than" + "greater" + "class" + "anything" + "install" + "measure" + "behavior" + "called" + "render" + "eval" + "I" + "am" + "does" + "some" + "mod" + "equal" + "equals" + "really" + "include" + "includes" + "contain" + "undefined" + "exist" + "match")) + +(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords))) + +;; ── Main tokenizer ──────────────────────────────────────────────── + +(define + hs-tokenize + (fn + (src) + (let + ((tokens (list)) (pos 0) (src-len (len src))) + (define + hs-peek + (fn + (offset) + (if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil))) + (define hs-cur (fn () (hs-peek 0))) + (define hs-advance! (fn (n) (set! pos (+ pos n)))) + (define + skip-ws! + (fn + () + (when + (and (< pos src-len) (hs-ws? (hs-cur))) + (hs-advance! 1) + (skip-ws!)))) + (define + skip-comment! + (fn + () + (when + (and (< pos src-len) (not (= (hs-cur) "\n"))) + (hs-advance! 1) + (skip-comment!)))) + (define + read-ident + (fn + (start) + (when + (and (< pos src-len) (hs-ident-char? (hs-cur))) + (hs-advance! 1) + (read-ident start)) + (slice src start pos))) + (define + read-number + (fn + (start) + (when + (and (< pos src-len) (hs-digit? (hs-cur))) + (hs-advance! 1) + (read-number start)) + (when + (and + (< pos src-len) + (= (hs-cur) ".") + (< (+ pos 1) src-len) + (hs-digit? (hs-peek 1))) + (hs-advance! 1) + (define + read-frac + (fn + () + (when + (and (< pos src-len) (hs-digit? (hs-cur))) + (hs-advance! 1) + (read-frac)))) + (read-frac)) + (let + ((num-end pos)) + (when + (and + (< pos src-len) + (or (= (hs-cur) "m") (= (hs-cur) "s"))) + (if + (and + (= (hs-cur) "m") + (< (+ pos 1) src-len) + (= (hs-peek 1) "s")) + (hs-advance! 2) + (when (= (hs-cur) "s") (hs-advance! 1)))) + (slice src start pos)))) + (define + read-string + (fn + (quote-char) + (let + ((chars (list))) + (hs-advance! 1) + (define + loop + (fn + () + (cond + (>= pos src-len) + nil + (= (hs-cur) "\\") + (do + (hs-advance! 1) + (when + (< pos src-len) + (let + ((ch (hs-cur))) + (cond + (= ch "n") + (append! chars "\n") + (= ch "t") + (append! chars "\t") + (= ch "\\") + (append! chars "\\") + (= ch quote-char) + (append! chars quote-char) + :else (do (append! chars "\\") (append! chars ch))) + (hs-advance! 1))) + (loop)) + (= (hs-cur) quote-char) + (hs-advance! 1) + :else (do (append! chars (hs-cur)) (hs-advance! 1) (loop))))) + (loop) + (join "" chars)))) + (define + read-template + (fn + () + (let + ((chars (list))) + (hs-advance! 1) + (define + loop + (fn + () + (cond + (>= pos src-len) + nil + (= (hs-cur) "`") + (hs-advance! 1) + (and + (= (hs-cur) "$") + (< (+ pos 1) src-len) + (= (hs-peek 1) "{")) + (do + (append! chars "${") + (hs-advance! 2) + (let + ((depth 1)) + (define + inner + (fn + () + (when + (and (< pos src-len) (> depth 0)) + (cond + (= (hs-cur) "{") + (do + (set! depth (+ depth 1)) + (append! chars (hs-cur)) + (hs-advance! 1) + (inner)) + (= (hs-cur) "}") + (do + (set! depth (- depth 1)) + (when (> depth 0) (append! chars (hs-cur))) + (hs-advance! 1) + (when (> depth 0) (inner))) + :else (do + (append! chars (hs-cur)) + (hs-advance! 1) + (inner)))))) + (inner)) + (append! chars "}") + (loop)) + :else (do (append! chars (hs-cur)) (hs-advance! 1) (loop))))) + (loop) + (join "" chars)))) + (define + read-selector + (fn + () + (let + ((chars (list))) + (hs-advance! 1) + (define + loop + (fn + () + (cond + (>= pos src-len) + nil + (and + (= (hs-cur) "/") + (< (+ pos 1) src-len) + (= (hs-peek 1) ">")) + (hs-advance! 2) + :else (do (append! chars (hs-cur)) (hs-advance! 1) (loop))))) + (loop) + (join "" chars)))) + (define + read-class-name + (fn + (start) + (when + (and + (< pos src-len) + (or + (hs-ident-char? (hs-cur)) + (= (hs-cur) ":") + (= (hs-cur) "\\") + (= (hs-cur) "[") + (= (hs-cur) "]") + (= (hs-cur) "(") + (= (hs-cur) ")"))) + (when (= (hs-cur) "\\") (hs-advance! 1)) + (hs-advance! 1) + (read-class-name start)) + (slice src start pos))) + (define + hs-emit! + (fn + (type value start) + (append! tokens (hs-make-token type value start)))) + (define + scan! + (fn + () + (skip-ws!) + (when + (< pos src-len) + (let + ((ch (hs-cur)) (start pos)) + (cond + (and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/")) + (do (hs-advance! 2) (skip-comment!) (scan!)) + (and + (= ch "<") + (< (+ pos 1) src-len) + (not (= (hs-peek 1) "=")) + (or + (hs-letter? (hs-peek 1)) + (= (hs-peek 1) ".") + (= (hs-peek 1) "#") + (= (hs-peek 1) "[") + (= (hs-peek 1) "*") + (= (hs-peek 1) ":"))) + (do (hs-emit! "selector" (read-selector) start) (scan!)) + (and + (= ch ".") + (< (+ pos 1) src-len) + (or + (hs-letter? (hs-peek 1)) + (= (hs-peek 1) "-") + (= (hs-peek 1) "_"))) + (do + (hs-advance! 1) + (hs-emit! "class" (read-class-name pos) start) + (scan!)) + (and + (= ch "#") + (< (+ pos 1) src-len) + (hs-ident-start? (hs-peek 1))) + (do + (hs-advance! 1) + (hs-emit! "id" (read-ident pos) start) + (scan!)) + (and + (= ch "@") + (< (+ pos 1) src-len) + (hs-ident-char? (hs-peek 1))) + (do + (hs-advance! 1) + (hs-emit! "attr" (read-ident pos) start) + (scan!)) + (and + (= ch "~") + (< (+ pos 1) src-len) + (hs-letter? (hs-peek 1))) + (do + (hs-advance! 1) + (hs-emit! "component" (str "~" (read-ident pos)) start) + (scan!)) + (and + (= ch "*") + (< (+ pos 1) src-len) + (hs-letter? (hs-peek 1))) + (do + (hs-advance! 1) + (hs-emit! "style" (read-ident pos) start) + (scan!)) + (and + (= ch ":") + (< (+ pos 1) src-len) + (hs-ident-start? (hs-peek 1))) + (do + (hs-advance! 1) + (hs-emit! "local" (read-ident pos) start) + (scan!)) + (or + (= ch "\"") + (and + (= ch "'") + (not + (and + (< (+ pos 1) src-len) + (= (hs-peek 1) "s") + (or + (>= (+ pos 2) src-len) + (not (hs-ident-char? (hs-peek 2)))))))) + (do (hs-emit! "string" (read-string ch) start) (scan!)) + (= ch "`") + (do (hs-emit! "template" (read-template) start) (scan!)) + (hs-digit? ch) + (do (hs-emit! "number" (read-number start) start) (scan!)) + (hs-ident-start? ch) + (do + (let + ((word (read-ident start))) + (hs-emit! + (if (hs-keyword? word) "keyword" "ident") + word + start)) + (scan!)) + (and + (or (= ch "=") (= ch "!") (= ch "<") (= ch ">")) + (< (+ pos 1) src-len) + (= (hs-peek 1) "=")) + (do + (if + (and + (or (= ch "=") (= ch "!")) + (< (+ pos 2) src-len) + (= (hs-peek 2) "=")) + (do (hs-emit! "op" (str ch "==") start) (hs-advance! 3)) + (do (hs-emit! "op" (str ch "=") start) (hs-advance! 2))) + (scan!)) + (and + (= ch "'") + (< (+ pos 1) src-len) + (= (hs-peek 1) "s") + (or + (>= (+ pos 2) src-len) + (not (hs-ident-char? (hs-peek 2))))) + (do (hs-emit! "op" "'s" start) (hs-advance! 2) (scan!)) + (= ch "(") + (do + (hs-emit! "paren-open" "(" start) + (hs-advance! 1) + (scan!)) + (= ch ")") + (do + (hs-emit! "paren-close" ")" start) + (hs-advance! 1) + (scan!)) + (= ch "[") + (do + (hs-emit! "bracket-open" "[" start) + (hs-advance! 1) + (scan!)) + (= ch "]") + (do + (hs-emit! "bracket-close" "]" start) + (hs-advance! 1) + (scan!)) + (= ch "{") + (do + (hs-emit! "brace-open" "{" start) + (hs-advance! 1) + (scan!)) + (= ch "}") + (do + (hs-emit! "brace-close" "}" start) + (hs-advance! 1) + (scan!)) + (= ch ",") + (do (hs-emit! "comma" "," start) (hs-advance! 1) (scan!)) + (= ch "+") + (do (hs-emit! "op" "+" start) (hs-advance! 1) (scan!)) + (= ch "-") + (do (hs-emit! "op" "-" start) (hs-advance! 1) (scan!)) + (= ch "/") + (do (hs-emit! "op" "/" start) (hs-advance! 1) (scan!)) + (= ch "=") + (do (hs-emit! "op" "=" start) (hs-advance! 1) (scan!)) + (= ch "<") + (do (hs-emit! "op" "<" start) (hs-advance! 1) (scan!)) + (= ch ">") + (do (hs-emit! "op" ">" start) (hs-advance! 1) (scan!)) + (= ch "!") + (do (hs-emit! "op" "!" start) (hs-advance! 1) (scan!)) + (= ch "*") + (do (hs-emit! "op" "*" start) (hs-advance! 1) (scan!)) + (= ch "%") + (do (hs-emit! "op" "%" start) (hs-advance! 1) (scan!)) + (= ch ".") + (do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!)) + :else (do (hs-advance! 1) (scan!))))))) + (scan!) + (hs-emit! "eof" nil pos) + tokens))) \ No newline at end of file