Step 18 (part 4): _hyperscript compiler — AST → SX expressions
lib/hyperscript/compiler.sx — transforms parsed hyperscript AST into
SX expressions targeting web/lib/dom.sx primitives. Two entry points:
hs-to-sx — AST node → SX expression
hs-to-sx-from-source — source string → SX (tokenize+parse+emit)
Compiler handles:
Expressions: me/it/event, refs, queries, attrs, styles, locals,
arithmetic, comparison, boolean, array literals, property access,
DOM traversal (closest/next/previous/first/last), type conversion,
membership test, exists/empty/matches/contains predicates
Commands: add/remove/toggle class, set (var/attr/style/prop dispatch),
put, if/else, do, wait, wait-for, log, send, trigger, hide, show,
transition, repeat, fetch, call, return, throw, settle, go, append,
tell (rebinds me), for, take, make, install, measure, inc/dec
Features: on (with from/filter/every), init, def, behavior
Maps to SX primitives: dom-add-class, dom-set-attr, dom-set-style,
dom-set-prop, dom-query, dom-closest, dom-dispatch, dom-append, etc.
33 compiler tests across 10 suites. 3076/3076 full build, zero regressions.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1311,6 +1311,7 @@ let run_spec_tests env test_files =
|
||||
let hs_dir = Filename.concat lib_dir "hyperscript" in
|
||||
load_module "tokenizer.sx" hs_dir;
|
||||
load_module "parser.sx" hs_dir;
|
||||
load_module "compiler.sx" hs_dir;
|
||||
load_module "types.sx" lib_dir;
|
||||
load_module "sx-swap.sx" lib_dir;
|
||||
(* Shared templates: TW styling engine *)
|
||||
|
||||
530
lib/hyperscript/compiler.sx
Normal file
530
lib/hyperscript/compiler.sx
Normal file
@@ -0,0 +1,530 @@
|
||||
;; _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
|
||||
(target)
|
||||
(let
|
||||
((t (hs-to-sx target)))
|
||||
(if
|
||||
(and (list? target) (= (first target) (quote attr)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote dom-get-attr)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1))
|
||||
1))
|
||||
(list (quote set!) t (list (quote +) t 1))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
(target)
|
||||
(let
|
||||
((t (hs-to-sx target)))
|
||||
(if
|
||||
(and (list? target) (= (first target) (quote attr)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote dom-get-attr)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 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 me)) (quote me))
|
||||
((= head (quote it)) (quote it))
|
||||
((= head (quote event)) (quote event))
|
||||
((= head dot-sym)
|
||||
(list (quote get) (hs-to-sx (nth ast 1)) (nth ast 2)))
|
||||
((= 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 not) (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-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
|
||||
pct-sym
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote empty?))
|
||||
(list (quote 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 dom-matches?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote contains?))
|
||||
(list
|
||||
(quote 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 contains?)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 1))))
|
||||
((= head (quote of))
|
||||
(list
|
||||
(quote get)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 1))))
|
||||
((= 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)))
|
||||
((= head (quote decrement!)) (emit-dec (nth ast 1)))
|
||||
((= 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))
|
||||
(true ast))))))))
|
||||
|
||||
;; ── Convenience: source → SX ─────────────────────────────────
|
||||
(define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src))))
|
||||
242
spec/tests/test-hyperscript-compiler.sx
Normal file
242
spec/tests/test-hyperscript-compiler.sx
Normal file
@@ -0,0 +1,242 @@
|
||||
;; _hyperscript compiler tests
|
||||
;; Tests that hs-to-sx (AST → SX) produces correct output
|
||||
;; Uses hs-to-sx-from-source for end-to-end source→SX tests
|
||||
|
||||
;; ── Class commands ────────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-classes"
|
||||
(deftest
|
||||
"add class to me"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "add .active to me")))
|
||||
(assert= (quote dom-add-class) (first sx))
|
||||
(assert= (quote me) (nth sx 1))
|
||||
(assert= "active" (nth sx 2))))
|
||||
(deftest
|
||||
"remove class from target"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "remove .old from #box")))
|
||||
(assert= (quote dom-remove-class) (first sx))
|
||||
(assert= (quote dom-query) (first (nth sx 1)))
|
||||
(assert= "old" (nth sx 2))))
|
||||
(deftest
|
||||
"toggle class"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "toggle .visible on me")))
|
||||
(assert= (quote hs-toggle-class!) (first sx))
|
||||
(assert= (quote me) (nth sx 1)))))
|
||||
|
||||
;; ── Set command ───────────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-set"
|
||||
(deftest
|
||||
"set variable to value"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "set x to 42")))
|
||||
(assert= (quote set!) (first sx))
|
||||
(assert= (quote x) (nth sx 1))
|
||||
(assert= 42 (nth sx 2))))
|
||||
(deftest
|
||||
"set attribute"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "set @title to 'hello'")))
|
||||
(assert= (quote dom-set-attr) (first sx))
|
||||
(assert= "title" (nth sx 2))
|
||||
(assert= "hello" (nth sx 3))))
|
||||
(deftest
|
||||
"set style"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "set *color to 'red'")))
|
||||
(assert= (quote dom-set-style) (first sx))
|
||||
(assert= "color" (nth sx 2))
|
||||
(assert= "red" (nth sx 3)))))
|
||||
|
||||
;; ── Arithmetic ────────────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-arithmetic"
|
||||
(deftest
|
||||
"addition passes through"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "set x to 1 + 2")))
|
||||
(let
|
||||
((val (nth sx 2)))
|
||||
(assert= (quote +) (first val))
|
||||
(assert= 1 (nth val 1))
|
||||
(assert= 2 (nth val 2)))))
|
||||
(deftest
|
||||
"comparison emits correctly"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "if x == 5 log x end")))
|
||||
(let ((cnd (nth sx 1))) (assert= (quote =) (first cnd))))))
|
||||
|
||||
;; ── Control flow ──────────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-control-flow"
|
||||
(deftest
|
||||
"if-then becomes when"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "if true log 1 end")))
|
||||
(assert= (quote when) (first sx))))
|
||||
(deftest
|
||||
"if-else becomes if"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "if true log 1 else log 2 end")))
|
||||
(assert= (quote if) (first sx))))
|
||||
(deftest
|
||||
"for becomes for-each"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "for item in items log item end")))
|
||||
(assert= (quote for-each) (first sx))
|
||||
(assert= (quote fn) (first (nth sx 1)))))
|
||||
(deftest
|
||||
"tell rebinds me"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "tell <div/> add .active end")))
|
||||
(assert= (quote let) (first sx))
|
||||
(assert= (quote me) (first (first (nth sx 1)))))))
|
||||
|
||||
;; ── DOM commands ──────────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-dom-commands"
|
||||
(deftest
|
||||
"hide sets display none"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "hide")))
|
||||
(assert= (quote dom-set-style) (first sx))
|
||||
(assert= (quote me) (nth sx 1))
|
||||
(assert= "display" (nth sx 2))
|
||||
(assert= "none" (nth sx 3))))
|
||||
(deftest
|
||||
"show clears display"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "show")))
|
||||
(assert= (quote dom-set-style) (first sx))
|
||||
(assert= (quote me) (nth sx 1))
|
||||
(assert= "" (nth sx 3))))
|
||||
(deftest
|
||||
"log passes through"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "log 'hello'")))
|
||||
(assert= (quote log) (first sx))
|
||||
(assert= "hello" (nth sx 1))))
|
||||
(deftest
|
||||
"append becomes dom-append"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "append 'text' to me")))
|
||||
(assert= (quote dom-append) (first sx)))))
|
||||
|
||||
;; ── Expressions ───────────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-expressions"
|
||||
(deftest
|
||||
"me emits as symbol"
|
||||
(let ((sx (hs-to-sx (list (quote me))))) (assert= (quote me) sx)))
|
||||
(deftest
|
||||
"ref emits as symbol"
|
||||
(let
|
||||
((sx (hs-to-sx (list (quote ref) "myVar"))))
|
||||
(assert= (quote myVar) sx)))
|
||||
(deftest
|
||||
"query emits dom-query"
|
||||
(let
|
||||
((sx (hs-to-sx (list (quote query) ".foo"))))
|
||||
(assert= (quote dom-query) (first sx))
|
||||
(assert= ".foo" (nth sx 1))))
|
||||
(deftest
|
||||
"attr emits dom-get-attr"
|
||||
(let
|
||||
((sx (hs-to-sx (list (quote attr) "href" (list (quote me))))))
|
||||
(assert= (quote dom-get-attr) (first sx))
|
||||
(assert= "href" (nth sx 2))))
|
||||
(deftest
|
||||
"exists becomes not nil?"
|
||||
(let
|
||||
((sx (hs-to-sx (list (quote exists?) (list (quote ref) "x")))))
|
||||
(assert= (quote not) (first sx))
|
||||
(assert= (quote nil?) (first (nth sx 1)))))
|
||||
(deftest
|
||||
"array becomes list"
|
||||
(let
|
||||
((sx (hs-to-sx (list (quote array) 1 2 3))))
|
||||
(assert= (quote list) (first sx))
|
||||
(assert= 1 (nth sx 1))
|
||||
(assert= 3 (nth sx 3)))))
|
||||
|
||||
;; ── On feature ────────────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-on"
|
||||
(deftest
|
||||
"on click add class"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "on click add .active end")))
|
||||
(assert= (quote hs-on) (first sx))
|
||||
(assert= (quote me) (nth sx 1))
|
||||
(assert= "click" (nth sx 2))
|
||||
(assert= (quote fn) (first (nth sx 3)))))
|
||||
(deftest
|
||||
"on click from target"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "on click from #btn add .clicked end")))
|
||||
(assert= (quote hs-on) (first sx))
|
||||
(assert= (quote dom-query) (first (nth sx 1)))))
|
||||
(deftest
|
||||
"on every click"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "on every click add .pulse end")))
|
||||
(assert= (quote hs-on-every) (first sx)))))
|
||||
|
||||
;; ── Def and behavior ─────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-def-behavior"
|
||||
(deftest
|
||||
"def becomes define"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "def greet(name) log name end")))
|
||||
(assert= (quote define) (first sx))
|
||||
(assert= (quote greet) (nth sx 1))
|
||||
(assert= (quote fn) (first (nth sx 2)))))
|
||||
(deftest
|
||||
"init wraps in hs-init"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "init log 'ready' end")))
|
||||
(assert= (quote hs-init) (first sx))
|
||||
(assert= (quote fn) (first (nth sx 1))))))
|
||||
|
||||
;; ── Return and throw ─────────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-return-throw"
|
||||
(deftest
|
||||
"return unwraps to value"
|
||||
(let ((sx (hs-to-sx-from-source "return 42"))) (assert= 42 sx)))
|
||||
(deftest
|
||||
"throw becomes raise"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "throw 'oops'")))
|
||||
(assert= (quote raise) (first sx))
|
||||
(assert= "oops" (nth sx 1))))
|
||||
(deftest
|
||||
"wait emits hs-wait"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "wait 100ms")))
|
||||
(assert= (quote hs-wait) (first sx))
|
||||
(assert= 100 (nth sx 1))))
|
||||
(deftest
|
||||
"wait for emits hs-wait-for"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "wait for transitionend")))
|
||||
(assert= (quote hs-wait-for) (first sx))
|
||||
(assert= "transitionend" (nth sx 2)))))
|
||||
|
||||
;; ── Increment / decrement ────────────────────────────────────
|
||||
(defsuite
|
||||
"hs-emit-inc-dec"
|
||||
(deftest
|
||||
"increment attribute"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "increment @count")))
|
||||
(assert= (quote dom-set-attr) (first sx))))
|
||||
(deftest
|
||||
"decrement attribute"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "decrement @count")))
|
||||
(assert= (quote dom-set-attr) (first sx)))))
|
||||
Reference in New Issue
Block a user