diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 3a423a5e..0169bbdf 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -524,6 +524,45 @@ (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))))) (true ast)))))))) ;; ── Convenience: source → SX ───────────────────────────────── diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index fea84b91..dc21ddad 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -7,7 +7,7 @@ (define hs-parse (fn - (tokens) + (tokens src) (let ((p 0) (tok-len (len tokens))) (define tp (fn () (if (< p tok-len) (nth tokens p) nil))) @@ -116,6 +116,13 @@ (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")) @@ -170,6 +177,8 @@ (let ((operand (parse-atom))) (list (quote -) 0 operand)))) + ((= typ "component") + (do (adv!) (list (quote component) val))) (true nil))))) (define parse-poss @@ -702,7 +711,68 @@ (let ((body (parse-feat-body))) (match-kw "end") - (list (quote behavior) name params body))))))) + (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 @@ -768,6 +838,8 @@ (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 @@ -853,4 +925,4 @@ (cons (quote do) features)))))) ;; ── Convenience: source string → AST ───────────────────────────── -(define hs-compile (fn (src) (hs-parse (hs-tokenize src)))) +(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src))) diff --git a/lib/hyperscript/tokenizer.sx b/lib/hyperscript/tokenizer.sx index 76ef2284..fce720ac 100644 --- a/lib/hyperscript/tokenizer.sx +++ b/lib/hyperscript/tokenizer.sx @@ -137,7 +137,9 @@ "install" "measure" "behavior" - "called")) + "called" + "render" + "eval")) (define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords))) @@ -408,6 +410,14 @@ (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) diff --git a/spec/tests/test-hyperscript-compiler.sx b/spec/tests/test-hyperscript-compiler.sx index dd68e34c..69c7ec0a 100644 --- a/spec/tests/test-hyperscript-compiler.sx +++ b/spec/tests/test-hyperscript-compiler.sx @@ -203,6 +203,55 @@ (assert= (quote fn) (first (nth sx 1)))))) ;; ── Return and throw ───────────────────────────────────────── +(defsuite + "hs-emit-render" + (deftest + "render emits render-to-html" + (let + ((sx (hs-to-sx-from-source "render ~card"))) + (assert= (quote render-to-html) (first sx)) + (assert= (quote ~card) (nth sx 1)))) + (deftest + "render with kwargs emits keywords" + (let + ((sx (hs-to-sx-from-source "render ~card :title 'Hi'"))) + (assert= (quote render-to-html) (first sx)) + (assert= (quote ~card) (nth sx 1)) + (assert= (make-keyword "title") (nth sx 2)) + (assert= "Hi" (nth sx 3)))) + (deftest + "render into emits hs-put!" + (let + ((sx (hs-to-sx-from-source "render ~card into #box"))) + (assert= (quote hs-put!) (first sx)) + (assert= (quote render-to-html) (first (nth sx 1))) + (assert= "into" (nth sx 2)))) + (deftest + "component ref emits symbol" + (let + ((sx (hs-to-sx (list (quote component) "~badge")))) + (assert= (quote ~badge) sx)))) + +;; ── Increment / decrement ──────────────────────────────────── +(defsuite + "hs-emit-sx-eval" + (deftest + "eval inlines SX at compile time" + (let + ((sx (hs-to-sx-from-source "set x to eval (+ 1 2)"))) + (assert= (quote set!) (first sx)) + (let + ((val (nth sx 2))) + (assert= (quote +) (first val)) + (assert= 1 (nth val 1)) + (assert= 2 (nth val 2))))) + (deftest + "eval preserves variable refs" + (let + ((sx (hs-to-sx-from-source "eval (log x)"))) + (assert= (quote log) (first sx)) + (assert= (quote x) (nth sx 1))))) + (defsuite "hs-emit-return-throw" (deftest @@ -227,7 +276,6 @@ (assert= (quote hs-wait-for) (first sx)) (assert= "transitionend" (nth sx 2))))) -;; ── Increment / decrement ──────────────────────────────────── (defsuite "hs-emit-inc-dec" (deftest diff --git a/spec/tests/test-hyperscript-parser.sx b/spec/tests/test-hyperscript-parser.sx index 2a57e5a4..a4208cec 100644 --- a/spec/tests/test-hyperscript-parser.sx +++ b/spec/tests/test-hyperscript-parser.sx @@ -649,6 +649,64 @@ (assert= "reset" (nth ast 1)) (assert= 0 (len (nth ast 2)))))) +(defsuite + "hs-parse-render" + (deftest + "render component" + (let + ((ast (hs-compile "render ~card"))) + (assert= (quote render) (first ast)) + (assert= "~card" (nth ast 1)) + (assert= 0 (len (nth ast 2))))) + (deftest + "render with kwargs" + (let + ((ast (hs-compile "render ~card :title 'Hello'"))) + (assert= "~card" (nth ast 1)) + (let + ((kw (nth ast 2))) + (assert= "title" (first kw)) + (assert= "Hello" (nth kw 1))))) + (deftest + "render into target" + (let + ((ast (hs-compile "render ~card :title 'Hi' into #box"))) + (assert= "into" (nth ast 3)) + (assert= (quote query) (first (nth ast 4))))) + (deftest + "component token in expression" + (let + ((ast (hs-compile "set x to ~myComp"))) + (let + ((val (nth ast 2))) + (assert= (quote component) (first val)) + (assert= "~myComp" (nth val 1)))))) + +(defsuite + "hs-parse-sx-eval" + (deftest + "eval with parens extracts raw SX" + (let + ((ast (hs-compile "set x to eval (+ 1 2)"))) + (let + ((val (nth ast 2))) + (assert= (quote sx-eval) (first val)) + (assert= "(+ 1 2)" (nth val 1))))) + (deftest + "eval with string fallback" + (let + ((ast (hs-compile "eval '(log 42)'"))) + (assert= (quote sx-eval) (first ast)) + (assert= "(log 42)" (nth ast 1)))) + (deftest + "eval nested parens" + (let + ((ast (hs-compile "set x to eval (map (fn (x) (+ x 1)) items)"))) + (let + ((val (nth ast 2))) + (assert= (quote sx-eval) (first val)) + (assert= "(map (fn (x) (+ x 1)) items)" (nth val 1)))))) + (defsuite "hs-parse-every-modifier" (deftest diff --git a/spec/tests/test-hyperscript-runtime.sx b/spec/tests/test-hyperscript-runtime.sx index df3d6425..d1f0d4aa 100644 --- a/spec/tests/test-hyperscript-runtime.sx +++ b/spec/tests/test-hyperscript-runtime.sx @@ -125,4 +125,22 @@ ((sx (hs-to-sx-from-source "def add(a, b) return a end"))) (assert= (quote define) (first sx)) (assert= (quote add) (nth sx 1)) - (assert= (quote fn) (first (nth sx 2)))))) \ No newline at end of file + (assert= (quote fn) (first (nth sx 2)))))) + +(defsuite + "hs-handler-extensions" + (deftest + "render compiles to render-to-html" + (let + ((sx (hs-to-sx-from-source "render ~badge :label 'New'"))) + (assert= (quote render-to-html) (first sx)) + (assert= (quote ~badge) (nth sx 1)))) + (deftest + "eval inlines SX with variable access" + (let + ((h (hs-handler "set x to 10 then set y to eval (+ x 5)"))) + (h "el") + (assert= 15 y))) + (deftest + "eval as command in handler" + (let ((h (hs-handler "eval (set! z 99)"))) (h "el") (assert= 99 z)))) \ No newline at end of file