Restore hyperscript work on stable site base (908f4f80)
Reset to last known-good state (908f4f80) where links, stepper, and
islands all work, then recovered all hyperscript implementation,
conformance tests, behavioral tests, Playwright specs, site sandbox,
IO-aware server loading, and upstream test suite from f271c88a.
Excludes runtime changes (VM resolve hook, VmSuspended browser handler,
sx_ref.ml guard recovery) that need careful re-integration.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -267,6 +267,210 @@
|
||||
((head (first ast)))
|
||||
(cond
|
||||
((= head (quote null-literal)) nil)
|
||||
((= head (quote object-literal))
|
||||
(let
|
||||
((pairs (nth ast 1)))
|
||||
(if
|
||||
(= (len pairs) 0)
|
||||
(list (quote dict))
|
||||
(cons
|
||||
(quote hs-make-object)
|
||||
(list
|
||||
(cons
|
||||
(quote list)
|
||||
(map
|
||||
(fn
|
||||
(pair)
|
||||
(list
|
||||
(quote list)
|
||||
(first pair)
|
||||
(hs-to-sx (nth pair 1))))
|
||||
pairs)))))))
|
||||
((= head (quote template))
|
||||
(let
|
||||
((raw (nth ast 1)))
|
||||
(let
|
||||
((parts (list)) (buf "") (i 0) (n (len raw)))
|
||||
(define
|
||||
tpl-flush
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(> (len buf) 0)
|
||||
(set! parts (append parts (list buf)))
|
||||
(set! buf ""))))
|
||||
(define
|
||||
tpl-read-id
|
||||
(fn
|
||||
(j)
|
||||
(if
|
||||
(and
|
||||
(< j n)
|
||||
(let
|
||||
((c (nth raw j)))
|
||||
(or
|
||||
(and (>= c "a") (<= c "z"))
|
||||
(and (>= c "A") (<= c "Z"))
|
||||
(and (>= c "0") (<= c "9"))
|
||||
(= c "_")
|
||||
(= c "."))))
|
||||
(tpl-read-id (+ j 1))
|
||||
j)))
|
||||
(define
|
||||
tpl-find-close
|
||||
(fn
|
||||
(j depth)
|
||||
(if
|
||||
(>= j n)
|
||||
j
|
||||
(if
|
||||
(= (nth raw j) "}")
|
||||
(if
|
||||
(= depth 1)
|
||||
j
|
||||
(tpl-find-close (+ j 1) (- depth 1)))
|
||||
(if
|
||||
(= (nth raw j) "{")
|
||||
(tpl-find-close (+ j 1) (+ depth 1))
|
||||
(tpl-find-close (+ j 1) depth))))))
|
||||
(define
|
||||
tpl-collect
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(< i n)
|
||||
(let
|
||||
((ch (nth raw i)))
|
||||
(if
|
||||
(and (= ch "$") (< (+ i 1) n))
|
||||
(if
|
||||
(= (nth raw (+ i 1)) "{")
|
||||
(let
|
||||
((start (+ i 2)))
|
||||
(let
|
||||
((close (tpl-find-close start 1)))
|
||||
(let
|
||||
((expr-src (slice raw start close)))
|
||||
(do
|
||||
(tpl-flush)
|
||||
(set!
|
||||
parts
|
||||
(append
|
||||
parts
|
||||
(list
|
||||
(hs-to-sx (hs-compile expr-src)))))
|
||||
(set! i (+ close 1))
|
||||
(tpl-collect)))))
|
||||
(let
|
||||
((start (+ i 1)))
|
||||
(let
|
||||
((end (tpl-read-id start)))
|
||||
(let
|
||||
((ident (slice raw start end)))
|
||||
(do
|
||||
(tpl-flush)
|
||||
(set!
|
||||
parts
|
||||
(append
|
||||
parts
|
||||
(list
|
||||
(hs-to-sx (hs-compile ident)))))
|
||||
(set! i end)
|
||||
(tpl-collect))))))
|
||||
(do
|
||||
(set! buf (str buf ch))
|
||||
(set! i (+ i 1))
|
||||
(tpl-collect)))))))
|
||||
(tpl-collect)
|
||||
(tpl-flush)
|
||||
(cons (quote str) parts))))
|
||||
((= head (quote beep!))
|
||||
(list (quote hs-beep) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote array-index))
|
||||
(list
|
||||
(quote nth)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote array-slice))
|
||||
(list
|
||||
(quote hs-slice)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote prop-is))
|
||||
(list
|
||||
(quote hs-prop-is)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(nth ast 2)))
|
||||
((= head (quote coll-where))
|
||||
(list
|
||||
(quote filter)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx (nth ast 2)))
|
||||
(hs-to-sx (nth ast 1))))
|
||||
((= head (quote coll-sorted))
|
||||
(list
|
||||
(quote hs-sorted-by)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote coll-sorted-desc))
|
||||
(list
|
||||
(quote hs-sorted-by-desc)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote coll-mapped))
|
||||
(list
|
||||
(quote map)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(hs-to-sx (nth ast 2)))
|
||||
(hs-to-sx (nth ast 1))))
|
||||
((= head (quote coll-split))
|
||||
(list
|
||||
(quote hs-split-by)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote coll-joined))
|
||||
(list
|
||||
(quote hs-joined-by)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote method-call))
|
||||
(let
|
||||
((dot-node (nth ast 1))
|
||||
(args (map hs-to-sx (nth ast 2))))
|
||||
(if
|
||||
(and
|
||||
(list? dot-node)
|
||||
(= (first dot-node) (make-symbol ".")))
|
||||
(let
|
||||
((obj (hs-to-sx (nth dot-node 1)))
|
||||
(method (nth dot-node 2)))
|
||||
(cons
|
||||
(quote hs-method-call)
|
||||
(cons obj (cons method args))))
|
||||
(cons
|
||||
(quote hs-method-call)
|
||||
(cons (hs-to-sx dot-node) args)))))
|
||||
((= head (quote string-postfix))
|
||||
(list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2)))
|
||||
((= head (quote block-literal))
|
||||
(let
|
||||
((params (map make-symbol (nth ast 1)))
|
||||
(body (hs-to-sx (nth ast 2))))
|
||||
(if
|
||||
(= (len params) 0)
|
||||
body
|
||||
(list (quote fn) params body))))
|
||||
((= head (quote me)) (quote me))
|
||||
((= head (quote it)) (quote it))
|
||||
((= head (quote event)) (quote event))
|
||||
@@ -276,7 +480,7 @@
|
||||
(cond
|
||||
((= prop "first") (list (quote hs-first) target))
|
||||
((= prop "last") (list (quote hs-last) target))
|
||||
(true (list (quote get) target prop)))))
|
||||
(true (list (quote host-get) target prop)))))
|
||||
((= head (quote ref)) (make-symbol (nth ast 1)))
|
||||
((= head (quote query))
|
||||
(list (quote dom-query) (nth ast 1)))
|
||||
@@ -333,10 +537,13 @@
|
||||
(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))))
|
||||
(if
|
||||
(nil? (nth ast 2))
|
||||
(list (quote str) (hs-to-sx (nth ast 1)) "%")
|
||||
(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?))
|
||||
@@ -348,7 +555,7 @@
|
||||
(quote hs-matches?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote hs-contains?))
|
||||
((= head (quote contains?))
|
||||
(list
|
||||
(quote hs-contains?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
@@ -367,7 +574,7 @@
|
||||
(cond
|
||||
((= prop (quote first)) (list (quote first) target))
|
||||
((= prop (quote last)) (list (quote last) target))
|
||||
(true (list (quote get) target prop)))))
|
||||
(true (list (quote host-get) target prop)))))
|
||||
((= head "!=")
|
||||
(list
|
||||
(quote not)
|
||||
@@ -466,7 +673,7 @@
|
||||
((= 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))))
|
||||
(list (quote console-log) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote send)) (emit-send ast))
|
||||
((= head (quote trigger))
|
||||
(list
|
||||
@@ -491,9 +698,10 @@
|
||||
((= 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)))))
|
||||
(let
|
||||
((fn-expr (hs-to-sx (nth ast 1)))
|
||||
(args (map hs-to-sx (nth ast 2))))
|
||||
(cons fn-expr args)))
|
||||
((= head (quote return)) (hs-to-sx (nth ast 1)))
|
||||
((= head (quote throw))
|
||||
(list (quote raise) (hs-to-sx (nth ast 1))))
|
||||
|
||||
@@ -10,6 +10,26 @@
|
||||
;; Returns a function (fn (me) ...) that can be called with a DOM element.
|
||||
;; Uses eval-expr-cek to turn the SX data structure into a live closure.
|
||||
|
||||
(load-library! "hs-tokenizer")
|
||||
|
||||
;; ── Activate a single element ───────────────────────────────────
|
||||
;; Reads the _="..." attribute, compiles, and executes with me=element.
|
||||
;; Marks the element to avoid double-activation.
|
||||
|
||||
(load-library! "hs-parser")
|
||||
|
||||
;; ── Boot: scan entire document ──────────────────────────────────
|
||||
;; Called once at page load. Finds all elements with _ attribute,
|
||||
;; compiles their hyperscript, and activates them.
|
||||
|
||||
(load-library! "hs-compiler")
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(load-library! "hs-runtime")
|
||||
|
||||
(define
|
||||
hs-handler
|
||||
(fn
|
||||
@@ -25,10 +45,6 @@
|
||||
(list (list (quote it) nil) (list (quote event) nil))
|
||||
sx))))))
|
||||
|
||||
;; ── Activate a single element ───────────────────────────────────
|
||||
;; Reads the _="..." attribute, compiles, and executes with me=element.
|
||||
;; Marks the element to avoid double-activation.
|
||||
|
||||
(define
|
||||
hs-activate!
|
||||
(fn
|
||||
@@ -40,22 +56,14 @@
|
||||
(dom-set-data el "hs-active" true)
|
||||
(let ((handler (hs-handler src))) (handler el))))))
|
||||
|
||||
;; ── Boot: scan entire document ──────────────────────────────────
|
||||
;; Called once at page load. Finds all elements with _ attribute,
|
||||
;; compiles their hyperscript, and activates them.
|
||||
|
||||
(define
|
||||
hs-boot!
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((elements (dom-query-all (dom-body) "[_]")))
|
||||
((elements (dom-query-all (host-get (host-global "document") "body") "[_]")))
|
||||
(for-each (fn (el) (hs-activate! el)) elements))))
|
||||
|
||||
;; ── Boot subtree: for dynamic content ───────────────────────────
|
||||
;; Called after HTMX swaps or dynamic DOM insertion.
|
||||
;; Only activates elements within the given root.
|
||||
|
||||
(define
|
||||
hs-boot-subtree!
|
||||
(fn
|
||||
|
||||
@@ -71,9 +71,16 @@
|
||||
(if
|
||||
(and (= (tp-type) "class") (not (at-end?)))
|
||||
(let
|
||||
((prop (get (adv!) "value")))
|
||||
(parse-prop-chain (list (quote .) base prop)))
|
||||
base)))
|
||||
((prop (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-prop-chain (list (make-symbol ".") base prop))))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(parse-prop-chain (list (quote method-call) base args)))
|
||||
base))))
|
||||
(define
|
||||
parse-trav
|
||||
(fn
|
||||
@@ -109,12 +116,18 @@
|
||||
(cond
|
||||
((= typ "number") (do (adv!) (parse-dur val)))
|
||||
((= typ "string") (do (adv!) val))
|
||||
((= typ "template") (do (adv!) (list (quote template) 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 "beep"))
|
||||
(do
|
||||
(adv!)
|
||||
(when (and (= (tp-type) "op") (= (tp-val) "!")) (adv!))
|
||||
(list (quote beep!) (parse-expr))))
|
||||
((and (= typ "keyword") (= val "not"))
|
||||
(do (adv!) (list (quote not) (parse-expr))))
|
||||
((and (= typ "keyword") (= val "no"))
|
||||
@@ -166,7 +179,8 @@
|
||||
((= 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 "class")
|
||||
(do (adv!) (list (quote query) (str "." val))))
|
||||
((= typ "ident") (do (adv!) (list (quote ref) val)))
|
||||
((= typ "paren-open")
|
||||
(do
|
||||
@@ -175,6 +189,50 @@
|
||||
((expr (parse-expr)))
|
||||
(if (= (tp-type) "paren-close") (adv!) nil)
|
||||
expr)))
|
||||
((= typ "brace-open")
|
||||
(do
|
||||
(adv!)
|
||||
(define
|
||||
obj-collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(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))))))
|
||||
(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
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(obj-collect (cons (list key value) acc))))))))
|
||||
(list (quote object-literal) (obj-collect (list)))))
|
||||
((and (= typ "op") (= val "\\"))
|
||||
(do
|
||||
(adv!)
|
||||
(define
|
||||
bl-params
|
||||
(fn
|
||||
(acc)
|
||||
(cond
|
||||
((and (= (tp-type) "op") (= (tp-val) "-"))
|
||||
(if
|
||||
(and
|
||||
(< (+ p 1) (len tokens))
|
||||
(= (get (nth tokens (+ p 1)) "value") ">"))
|
||||
(do (adv!) (adv!) acc)
|
||||
acc))
|
||||
((= (tp-type) "ident")
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(when (= (tp-type) "comma") (adv!))
|
||||
(bl-params (append acc name)))))
|
||||
(true acc))))
|
||||
(let
|
||||
((params (bl-params (list))))
|
||||
(list (quote block-literal) params (parse-expr)))))
|
||||
((= typ "bracket-open") (do (adv!) (parse-array-lit)))
|
||||
((and (= typ "op") (= val "-"))
|
||||
(do
|
||||
@@ -233,6 +291,47 @@
|
||||
((and (= (tp-type) "op") (= (tp-val) "'s"))
|
||||
(do (adv!) (parse-poss-tail obj)))
|
||||
((= (tp-type) "class") (parse-prop-chain obj))
|
||||
((= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(list (quote call) obj args)))
|
||||
((= (tp-type) "bracket-open")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (tp-type) "op") (= (tp-val) ".."))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((end-expr (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(parse-poss
|
||||
(list (quote array-slice) obj nil end-expr))))
|
||||
(let
|
||||
((start-expr (parse-expr)))
|
||||
(if
|
||||
(and (= (tp-type) "op") (= (tp-val) ".."))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(= (tp-type) "bracket-close")
|
||||
(do
|
||||
(adv!)
|
||||
(parse-poss
|
||||
(list (quote array-slice) obj start-expr nil)))
|
||||
(let
|
||||
((end-expr (parse-expr)))
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(parse-poss
|
||||
(list
|
||||
(quote array-slice)
|
||||
obj
|
||||
start-expr
|
||||
end-expr)))))
|
||||
(do
|
||||
(when (= (tp-type) "bracket-close") (adv!))
|
||||
(parse-poss
|
||||
(list (quote array-index) obj start-expr))))))))
|
||||
(true obj))))
|
||||
(define
|
||||
parse-cmp
|
||||
@@ -344,9 +443,16 @@
|
||||
(list (quote type-check-strict) left type-name)
|
||||
(list (quote type-check) left type-name))))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(list (quote =) left right))))))
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(not (hs-keyword? (tp-val))))
|
||||
(let
|
||||
((prop-name (tp-val)))
|
||||
(do (adv!) (list (quote prop-is) left prop-name)))
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(list (quote =) left right)))))))
|
||||
((and (= typ "keyword") (= val "am"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -373,17 +479,41 @@
|
||||
(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!)
|
||||
(when (or (= (tp-val) "a") (= (tp-val) "an")) (adv!))
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (tp-type) "colon") (not (at-end?)))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((param (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list
|
||||
(quote as)
|
||||
left
|
||||
(str type-name ":" param)))))
|
||||
(list (quote as) left type-name))))))
|
||||
((and (= typ "colon"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((type-name (tp-val)))
|
||||
(adv!)
|
||||
(list (quote as) left type-name))))
|
||||
(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)))))))
|
||||
((and (= typ "keyword") (= val "of"))
|
||||
(do
|
||||
(adv!)
|
||||
@@ -425,6 +555,61 @@
|
||||
((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes")))
|
||||
(do (adv!) (list (quote contains?) left (parse-expr))))
|
||||
(true left)))))
|
||||
(define
|
||||
parse-collection
|
||||
(fn
|
||||
(left)
|
||||
(cond
|
||||
((match-kw "where")
|
||||
(let
|
||||
((cond-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(parse-collection (list (quote coll-where) left cond-expr))))
|
||||
((match-kw "sorted")
|
||||
(do
|
||||
(match-kw "by")
|
||||
(let
|
||||
((key-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(let
|
||||
((desc (match-kw "descending")))
|
||||
(when (not desc) (match-kw "ascending"))
|
||||
(parse-collection
|
||||
(if
|
||||
desc
|
||||
(list (quote coll-sorted-desc) left key-expr)
|
||||
(list (quote coll-sorted) left key-expr)))))))
|
||||
((match-kw "mapped")
|
||||
(do
|
||||
(match-kw "to")
|
||||
(let
|
||||
((map-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(parse-collection (list (quote coll-mapped) left map-expr)))))
|
||||
((match-kw "split")
|
||||
(do
|
||||
(match-kw "by")
|
||||
(let
|
||||
((sep (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(parse-collection (list (quote coll-split) left sep)))))
|
||||
((match-kw "joined")
|
||||
(do
|
||||
(match-kw "by")
|
||||
(let
|
||||
((sep (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
||||
(parse-collection (list (quote coll-joined) left sep)))))
|
||||
(true left))))
|
||||
(define
|
||||
parse-logical
|
||||
(fn
|
||||
(left)
|
||||
(cond
|
||||
((match-kw "and")
|
||||
(let
|
||||
((right (parse-collection (parse-cmp (parse-arith (parse-poss (parse-atom)))))))
|
||||
(parse-logical (list (quote and) left right))))
|
||||
((match-kw "or")
|
||||
(let
|
||||
((right (parse-collection (parse-cmp (parse-arith (parse-poss (parse-atom)))))))
|
||||
(parse-logical (list (quote or) left right))))
|
||||
(true left))))
|
||||
(define
|
||||
parse-expr
|
||||
(fn
|
||||
@@ -434,9 +619,43 @@
|
||||
(if
|
||||
(nil? left)
|
||||
nil
|
||||
(let
|
||||
((left2 (parse-poss left)))
|
||||
(let ((left3 (parse-arith left2))) (parse-cmp left3)))))))
|
||||
(do
|
||||
(when
|
||||
(and (number? left) (= (tp-type) "ident"))
|
||||
(let
|
||||
((unit (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(set! left (list (quote string-postfix) left unit)))))
|
||||
(let
|
||||
((l2 (parse-poss left)))
|
||||
(let
|
||||
((l3 (parse-arith l2)))
|
||||
(let
|
||||
((l4 (parse-cmp l3)))
|
||||
(let
|
||||
((l5 (parse-collection l4)))
|
||||
(let
|
||||
((result (parse-logical l5)))
|
||||
(if
|
||||
(and
|
||||
result
|
||||
(or
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(not
|
||||
(or
|
||||
(= (tp-val) "then")
|
||||
(= (tp-val) "end")
|
||||
(= (tp-val) "else")
|
||||
(= (tp-val) "otherwise"))))
|
||||
(and (= (tp-type) "op") (= (tp-val) "%"))))
|
||||
(let
|
||||
((unit (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote string-postfix) result unit)))
|
||||
result)))))))))))
|
||||
(define
|
||||
parse-tgt-kw
|
||||
(fn (kw default) (if (match-kw kw) (parse-expr) default)))
|
||||
|
||||
@@ -49,12 +49,7 @@
|
||||
;; Toggle a single class on an element.
|
||||
(define
|
||||
hs-toggle-class!
|
||||
(fn
|
||||
(target cls)
|
||||
(if
|
||||
(dom-has-class? target cls)
|
||||
(dom-remove-class target cls)
|
||||
(dom-add-class target cls))))
|
||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||
|
||||
;; Toggle between two classes — exactly one is active at a time.
|
||||
(define
|
||||
@@ -213,8 +208,27 @@
|
||||
((= type-name "Float") (+ value 0))
|
||||
((= type-name "Number") (+ value 0))
|
||||
((= type-name "String") (str value))
|
||||
((= type-name "Bool") (if value true false))
|
||||
((= type-name "Boolean") (if value true false))
|
||||
((= type-name "Array") (if (list? value) value (list value)))
|
||||
((= type-name "JSON") (str value))
|
||||
((= type-name "Object") (if (string? value) value value))
|
||||
((or (= type-name "Fixed") (string-contains? type-name "Fixed:"))
|
||||
(let
|
||||
((digits (if (string-contains? type-name ":") (parse-number (nth (split type-name ":") 1)) 0))
|
||||
(num (+ value 0)))
|
||||
(if
|
||||
(= digits 0)
|
||||
(str (floor num))
|
||||
(let
|
||||
((factor (reduce (fn (acc _) (* acc 10)) 1 (range 0 digits))))
|
||||
(let
|
||||
((rounded (/ (floor (+ (* num factor) 0.5)) factor)))
|
||||
(str rounded))))))
|
||||
((= type-name "HTML") (str value))
|
||||
((= type-name "Values") value)
|
||||
((= type-name "Fragment") (str value))
|
||||
((= type-name "Date") (str value))
|
||||
(true value))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
@@ -323,12 +337,15 @@
|
||||
((string? collection) (string-contains? collection (str item)))
|
||||
((list? collection)
|
||||
(if
|
||||
(= (len collection) 0)
|
||||
false
|
||||
(list? item)
|
||||
(filter (fn (x) (hs-contains? collection x)) item)
|
||||
(if
|
||||
(= (first collection) item)
|
||||
true
|
||||
(hs-contains? (rest collection) item))))
|
||||
(= (len collection) 0)
|
||||
false
|
||||
(if
|
||||
(= (first collection) item)
|
||||
true
|
||||
(hs-contains? (rest collection) item)))))
|
||||
(true false))))
|
||||
|
||||
(define
|
||||
@@ -344,4 +361,170 @@
|
||||
|
||||
(define hs-first (fn (lst) (first lst)))
|
||||
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
(define hs-last (fn (lst) (last lst)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-template
|
||||
(fn
|
||||
(raw)
|
||||
(let
|
||||
((result "") (i 0) (n (len raw)))
|
||||
(define
|
||||
tpl-loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(< i n)
|
||||
(let
|
||||
((ch (nth raw i)))
|
||||
(if
|
||||
(and (= ch "$") (< (+ i 1) n))
|
||||
(if
|
||||
(= (nth raw (+ i 1)) "{")
|
||||
(let
|
||||
((start (+ i 2)))
|
||||
(define
|
||||
find-close
|
||||
(fn
|
||||
(j depth)
|
||||
(if
|
||||
(>= j n)
|
||||
j
|
||||
(if
|
||||
(= (nth raw j) "}")
|
||||
(if
|
||||
(= depth 1)
|
||||
j
|
||||
(find-close (+ j 1) (- depth 1)))
|
||||
(if
|
||||
(= (nth raw j) "{")
|
||||
(find-close (+ j 1) (+ depth 1))
|
||||
(find-close (+ j 1) depth))))))
|
||||
(let
|
||||
((close (find-close start 1)))
|
||||
(let
|
||||
((expr-src (slice raw start close)))
|
||||
(do
|
||||
(set!
|
||||
result
|
||||
(str
|
||||
result
|
||||
(cek-eval (hs-to-sx (hs-compile expr-src)))))
|
||||
(set! i (+ close 1))
|
||||
(tpl-loop)))))
|
||||
(let
|
||||
((start (+ i 1)))
|
||||
(define
|
||||
read-id
|
||||
(fn
|
||||
(j)
|
||||
(if
|
||||
(and
|
||||
(< j n)
|
||||
(let
|
||||
((c (nth raw j)))
|
||||
(or
|
||||
(and (>= c "a") (<= c "z"))
|
||||
(and (>= c "A") (<= c "Z"))
|
||||
(and (>= c "0") (<= c "9"))
|
||||
(= c "_")
|
||||
(= c "."))))
|
||||
(read-id (+ j 1))
|
||||
j)))
|
||||
(let
|
||||
((end (read-id start)))
|
||||
(let
|
||||
((ident (slice raw start end)))
|
||||
(do
|
||||
(set!
|
||||
result
|
||||
(str
|
||||
result
|
||||
(cek-eval (hs-to-sx (hs-compile ident)))))
|
||||
(set! i end)
|
||||
(tpl-loop))))))
|
||||
(do
|
||||
(set! result (str result ch))
|
||||
(set! i (+ i 1))
|
||||
(tpl-loop)))))))
|
||||
(do (tpl-loop) result))))
|
||||
|
||||
(define
|
||||
hs-make-object
|
||||
(fn
|
||||
(pairs)
|
||||
(let
|
||||
((d {}))
|
||||
(do
|
||||
(for-each
|
||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||
pairs)
|
||||
d))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define host-get (fn (obj key) (if (= key "length") (len obj) (get obj key))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define dom-query (fn (selector) (list)))
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define hs-method-call (fn (obj method &rest args)
|
||||
(cond
|
||||
((= method "map") (map (first args) obj))
|
||||
((= method "push") (do (append! obj (first args)) obj))
|
||||
((= method "filter") (filter (first args) obj))
|
||||
((= method "join") (join obj (first args)))
|
||||
((= method "indexOf")
|
||||
(let ((item (first args)))
|
||||
(define idx-loop (fn (lst i)
|
||||
(if (= (len lst) 0) -1
|
||||
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
|
||||
(idx-loop obj 0)))
|
||||
(true nil))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define hs-beep (fn (v) v))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define hs-slice (fn (col start end)
|
||||
(let ((s (if (nil? start) 0 start))
|
||||
(e (if (nil? end) (len col) (+ end 1))))
|
||||
(slice col s e))))
|
||||
;; Collection: sorted by
|
||||
(define hs-sorted-by (fn (col key-fn)
|
||||
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
|
||||
(map (fn (p) (nth p 1))
|
||||
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
|
||||
;; Collection: sorted by descending
|
||||
(define hs-sorted-by-desc (fn (col key-fn)
|
||||
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
|
||||
(map (fn (p) (nth p 1))
|
||||
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
|
||||
;; Collection: split by
|
||||
(define hs-split-by (fn (s sep) (split s sep)))
|
||||
;; Collection: joined by
|
||||
(define hs-joined-by (fn (col sep) (join sep col)))
|
||||
|
||||
;; Override sorted-by — use decorate-sort-undecorate (no comparator arg to sort)
|
||||
(define hs-sorted-by (fn (col key-fn)
|
||||
(let ((decorated (map (fn (item) (list (key-fn item) item)) col)))
|
||||
(let ((sorted-dec (sort (map first decorated))))
|
||||
(define reorder (fn (keys acc remaining)
|
||||
(if (= (len keys) 0) acc
|
||||
(let ((k (first keys)))
|
||||
(define find-item (fn (lst)
|
||||
(if (= (len lst) 0) nil
|
||||
(if (= (first (first lst)) k) (first lst)
|
||||
(find-item (rest lst))))))
|
||||
(let ((found (find-item remaining)))
|
||||
(reorder (rest keys)
|
||||
(append acc (list (nth found 1)))
|
||||
(filter (fn (x) (not (= x found))) remaining)))))))
|
||||
(reorder sorted-dec (list) decorated)))))
|
||||
|
||||
(define hs-sorted-by-desc (fn (col key-fn)
|
||||
(reverse (hs-sorted-by col key-fn))))
|
||||
|
||||
@@ -153,7 +153,15 @@
|
||||
"contain"
|
||||
"undefined"
|
||||
"exist"
|
||||
"match"))
|
||||
"match"
|
||||
"beep"
|
||||
"where"
|
||||
"sorted"
|
||||
"mapped"
|
||||
"split"
|
||||
"joined"
|
||||
"descending"
|
||||
"ascending"))
|
||||
|
||||
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))
|
||||
|
||||
@@ -221,20 +229,46 @@
|
||||
(hs-advance! 1)
|
||||
(read-frac))))
|
||||
(read-frac))
|
||||
(let
|
||||
((num-end pos))
|
||||
(do
|
||||
(when
|
||||
(and
|
||||
(< pos src-len)
|
||||
(or (= (hs-cur) "m") (= (hs-cur) "s")))
|
||||
(if
|
||||
(or (= (hs-cur) "e") (= (hs-cur) "E"))
|
||||
(or
|
||||
(and (< (+ pos 1) src-len) (hs-digit? (hs-peek 1)))
|
||||
(and
|
||||
(< (+ pos 2) src-len)
|
||||
(or (= (hs-peek 1) "+") (= (hs-peek 1) "-"))
|
||||
(hs-digit? (hs-peek 2)))))
|
||||
(hs-advance! 1)
|
||||
(when
|
||||
(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))))
|
||||
(< pos src-len)
|
||||
(or (= (hs-cur) "+") (= (hs-cur) "-")))
|
||||
(hs-advance! 1))
|
||||
(define
|
||||
read-exp-digits
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(and (< pos src-len) (hs-digit? (hs-cur)))
|
||||
(hs-advance! 1)
|
||||
(read-exp-digits))))
|
||||
(read-exp-digits))
|
||||
(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
|
||||
@@ -359,12 +393,8 @@
|
||||
(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-cur) "]")))
|
||||
(hs-advance! 1)
|
||||
(read-class-name start))
|
||||
(slice src start pos)))
|
||||
@@ -397,6 +427,8 @@
|
||||
(= (hs-peek 1) "*")
|
||||
(= (hs-peek 1) ":")))
|
||||
(do (hs-emit! "selector" (read-selector) start) (scan!))
|
||||
(and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
|
||||
(do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
|
||||
(and
|
||||
(= ch ".")
|
||||
(< (+ pos 1) src-len)
|
||||
@@ -546,6 +578,10 @@
|
||||
(do (hs-emit! "op" "%" start) (hs-advance! 1) (scan!))
|
||||
(= ch ".")
|
||||
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
|
||||
(= ch "\\")
|
||||
(do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!))
|
||||
(= ch ":")
|
||||
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
|
||||
:else (do (hs-advance! 1) (scan!)))))))
|
||||
(scan!)
|
||||
(hs-emit! "eof" nil pos)
|
||||
|
||||
Reference in New Issue
Block a user