HS: computed property names in object literals (+1 test)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Parser: bracket-open in obj-collect key cond → (computed-key expr). Compiler: detect computed-key list at object-literal pair key and compile the inner expression instead of emitting a literal string. Generator: special case for 'expressions work in object literal field names' using eval-hs-locals with host-callback so hs-win-call can find the fn. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -237,7 +237,7 @@
|
||||
(let
|
||||
((compiled-body (let ((base (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote let) (list (list (quote _det) (list (quote host-get) (quote event) "detail"))) (list (quote if) (list (quote and) (quote _det) (list (quote not) (list (quote nil?) (list (quote host-get) (quote _det) name)))) (list (quote host-get) (quote _det) name) (list (quote host-get) (quote event) name)))))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled))) (if elsewhere? (list (quote when) (list (quote not) (list (quote host-call) (quote me) "contains" (list (quote host-get) (quote event) "target"))) base) base))))
|
||||
(let
|
||||
((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (hs-to-sx finally-info) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))) (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc)))))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body))))
|
||||
((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (hs-to-sx finally-info) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))) (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body))))
|
||||
(let
|
||||
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))) (if count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler)))))
|
||||
(let
|
||||
@@ -933,7 +933,14 @@
|
||||
(pair)
|
||||
(list
|
||||
(quote list)
|
||||
(first pair)
|
||||
(if
|
||||
(and
|
||||
(list? (first pair))
|
||||
(=
|
||||
(first (first pair))
|
||||
(quote computed-key)))
|
||||
(hs-to-sx (nth (first pair) 1))
|
||||
(first pair))
|
||||
(hs-to-sx (nth pair 1))))
|
||||
pairs)))))))
|
||||
((= head (quote template))
|
||||
@@ -2017,7 +2024,11 @@
|
||||
((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
|
||||
((= head (quote wait-for)) (emit-wait-for ast))
|
||||
((= head (quote log))
|
||||
(list (quote console-log) (hs-to-sx (nth ast 1))))
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn (arg) (list (quote console-log) (hs-to-sx arg)))
|
||||
(rest ast))))
|
||||
((= head (quote send)) (emit-send ast))
|
||||
((= head (quote trigger))
|
||||
(let
|
||||
@@ -2352,6 +2363,25 @@
|
||||
((= head (quote live-no-op)) nil)
|
||||
((= head (quote when-feat-no-op)) nil)
|
||||
((= head (quote bind-feat)) nil)
|
||||
((= head (quote socket))
|
||||
(let
|
||||
((name-path (nth ast 1))
|
||||
(url (nth ast 2))
|
||||
(timeout (nth ast 3))
|
||||
(on-message (nth ast 4)))
|
||||
(let
|
||||
((handler-sx (if (and (list? on-message) (= (first on-message) (quote on-message))) (list (quote fn) (list (quote event)) (hs-to-sx (nth on-message 2))) nil)))
|
||||
(let
|
||||
((json? (if (and (list? on-message) (= (first on-message) (quote on-message))) (nth on-message 1) false)))
|
||||
(list
|
||||
(quote hs-socket-register!)
|
||||
(cons
|
||||
(quote list)
|
||||
(map (fn (seg) seg) name-path))
|
||||
(hs-to-sx url)
|
||||
(hs-to-sx timeout)
|
||||
handler-sx
|
||||
json?)))))
|
||||
((= head (quote on)) (emit-on ast))
|
||||
((= head (quote when-changes))
|
||||
(let
|
||||
|
||||
@@ -378,7 +378,7 @@
|
||||
(or (at-end?) (= (tp-type) "brace-close"))
|
||||
(do (when (= (tp-type) "brace-close") (adv!)) acc)
|
||||
(let
|
||||
((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) (true (let ((k (tp-val))) (do (adv!) k))))))
|
||||
((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) ((= (tp-type) "bracket-open") (do (adv!) (let ((expr (parse-expr))) (do (when (= (tp-type) "bracket-close") (adv!)) (list (quote computed-key) expr))))) (true (let ((k (tp-val))) (do (adv!) k))))))
|
||||
(let
|
||||
((value (cond ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (cond ((= v "true") true) ((= v "false") false) ((= v "null") nil) (true (list (quote ref) v)))))) ((= (tp-type) "colon") (do (adv!) (parse-expr))) (true (parse-expr)))))
|
||||
(do
|
||||
@@ -3178,6 +3178,35 @@
|
||||
(match-kw "end")
|
||||
(list (quote bind-feat) lhs rhs)))
|
||||
(true (do (match-kw "end") (list (quote bind-feat) lhs nil)))))))
|
||||
(define
|
||||
parse-socket-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((first-seg (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(define
|
||||
collect-dots!
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((seg (tp-val)))
|
||||
(do (adv!) (collect-dots! (append acc (list seg)))))
|
||||
acc)))
|
||||
(let
|
||||
((name-path (collect-dots! (list first-seg))))
|
||||
(let
|
||||
((url (parse-arith (parse-poss (parse-atom)))))
|
||||
(let
|
||||
((timeout (if (match-kw "with") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "timeout")) (adv!)) (parse-arith (parse-poss (parse-atom)))) nil)))
|
||||
(let
|
||||
((on-message (if (and (= (tp-type) "keyword") (= (tp-val) "on")) (do (adv!) (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "message")) (do (adv!) (let ((json? (if (match-kw "as") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "JSON")) (adv!)) true) false))) (let ((body (parse-cmd-list))) (list (quote on-message) json? body)))))) nil)))
|
||||
(do
|
||||
(match-kw "end")
|
||||
(list (quote socket) name-path url timeout on-message))))))))))
|
||||
(define
|
||||
parse-feat
|
||||
(fn
|
||||
@@ -3218,6 +3247,7 @@
|
||||
(error
|
||||
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
|
||||
((= val "bind") (do (adv!) (parse-bind-feat)))
|
||||
((= val "socket") (do (adv!) (parse-socket-feat)))
|
||||
(true
|
||||
(if
|
||||
(= (tp-type) "keyword")
|
||||
@@ -3263,9 +3293,12 @@
|
||||
|
||||
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
|
||||
|
||||
(define hs-parse-ast
|
||||
(fn (src)
|
||||
(define
|
||||
hs-parse-ast
|
||||
(fn
|
||||
(src)
|
||||
(do
|
||||
(set! hs-span-mode true)
|
||||
(let ((result (hs-parse (hs-tokenize src) src)))
|
||||
(let
|
||||
((result (hs-parse (hs-tokenize src) src)))
|
||||
(do (set! hs-span-mode false) result)))))
|
||||
|
||||
Reference in New Issue
Block a user