HS: repeat property for-loops + where (+3 tests)
Re-applied from worktree-agent-a7c6dca2be5bbada0 (commit c4241d57)
onto HEAD that already has clusters 30, 26, 27 runtime changes —
straight cherry-pick conflicted on the cluster-30 log-all block
and cluster-27 intersection helper, so the logical diff was
replayed surgically.
Parser (parse-atom object-literal):
- obj-collect now `append`s pairs in source order instead of
`cons`'ing, so `{foo:1, bar:2, baz:3}` reaches hs-make-object
as `((foo 1) (bar 2) (baz 3))`.
Compiler (emit-for, array-index emission):
- emit-for detects `for x in COLL where COND` (parser wraps COLL
as `(coll-where INNER COND)`) and rewrites the filter lambda
to bind the for-loop variable name rather than the default
`it`, so `where x.val > 10` sees the right binding. Also
unwraps `coll-where` so filter targets the real inner coll.
- emit-for now wraps a symbol collection with `cek-try` (not the
broken `hs-safe-call`, which has an uninitialised CEK call-ref
in the WASM build) so `for prop in x` after `set x to {…}`
iterates x's keys instead of nil.
- array-index emits `(hs-index obj key)` instead of
`(nth obj key)`, which only worked on lists.
Runtime:
- New polymorphic `hs-index` dispatches to get / nth / host-get
based on target type (dict / list / string / otherwise).
- `hs-put-at!` default branch now detects DOM elements via
`hs-element?` and delegates to `hs-put!`, so `put X at end of
elt` on a DOM node appends innerHTML instead of crashing.
- `hs-make-object` tracks insertion order in a hidden `_order`
list; `hs-for-each` and `hs-coerce` (Keys / Entries / Map
branches) prefer `_order` when present, filtering the marker
out of output.
Suite hs-upstream-repeat: 25/30 → 28/30 (+3).
Smoke 0-195 unchanged at 165/195.
This commit is contained in:
@@ -337,14 +337,33 @@
|
||||
(ast)
|
||||
(let
|
||||
((var-name (nth ast 1))
|
||||
(raw-coll (hs-to-sx (nth ast 2)))
|
||||
(collection
|
||||
(raw-coll-ast (nth ast 2))
|
||||
(where-cond
|
||||
(if
|
||||
(and
|
||||
(list? raw-coll-ast)
|
||||
(= (first raw-coll-ast) (quote coll-where)))
|
||||
(hs-to-sx (nth raw-coll-ast 2))
|
||||
nil))
|
||||
(inner-coll-ast
|
||||
(if where-cond (nth raw-coll-ast 1) raw-coll-ast))
|
||||
(raw-coll (hs-to-sx inner-coll-ast))
|
||||
(safe-coll
|
||||
(if
|
||||
(symbol? raw-coll)
|
||||
(list
|
||||
(quote hs-safe-call)
|
||||
(list (quote fn) (list) raw-coll))
|
||||
(quote cek-try)
|
||||
(list (quote fn) (list) raw-coll)
|
||||
(list (quote fn) (list (quote _e)) nil))
|
||||
raw-coll))
|
||||
(collection
|
||||
(if
|
||||
where-cond
|
||||
(list
|
||||
(quote filter)
|
||||
(list (quote fn) (list (make-symbol var-name)) where-cond)
|
||||
safe-coll)
|
||||
safe-coll))
|
||||
(body (hs-to-sx (nth ast 3))))
|
||||
(if
|
||||
(and (> (len ast) 4) (= (nth ast 4) :index))
|
||||
@@ -839,7 +858,7 @@
|
||||
(list (quote hs-beep) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote array-index))
|
||||
(list
|
||||
(quote nth)
|
||||
(quote hs-index)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote array-slice))
|
||||
|
||||
@@ -244,7 +244,8 @@
|
||||
((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))))))))
|
||||
(obj-collect
|
||||
(append acc (list (list key value))))))))))
|
||||
(list (quote object-literal) (obj-collect (list)))))
|
||||
((and (= typ "op") (= val "\\"))
|
||||
(do
|
||||
|
||||
@@ -387,6 +387,21 @@
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
(define
|
||||
hs-index
|
||||
(fn
|
||||
(obj key)
|
||||
(cond
|
||||
((nil? obj) nil)
|
||||
((dict? obj) (get obj key))
|
||||
((list? obj) (nth obj key))
|
||||
((string? obj) (nth obj key))
|
||||
(true (host-get obj key)))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
(define
|
||||
hs-put-at!
|
||||
(fn
|
||||
@@ -398,17 +413,20 @@
|
||||
(= pos "start")
|
||||
(cons value target)
|
||||
(append target (list value))))
|
||||
(true
|
||||
(cond
|
||||
((hs-element? target) (do (hs-put! value pos target) target))
|
||||
(true
|
||||
(do
|
||||
(cond
|
||||
((= pos "end") (host-call target "push" value))
|
||||
((= pos "start") (host-call target "unshift" value)))
|
||||
target)))))
|
||||
target)))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define
|
||||
hs-dict-without
|
||||
(fn
|
||||
@@ -429,27 +447,27 @@
|
||||
(host-call (host-global "Reflect") "deleteProperty" out key)
|
||||
out)))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
;; Install a behavior on an element.
|
||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||
;; (hs-install behavior-fn me ...args)
|
||||
(define
|
||||
hs-set-on!
|
||||
(fn
|
||||
(props target)
|
||||
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
;; Install a behavior on an element.
|
||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||
;; (hs-install behavior-fn me ...args)
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
(define
|
||||
hs-scroll!
|
||||
(fn
|
||||
@@ -462,10 +480,11 @@
|
||||
((= position "bottom") (dict :block "end"))
|
||||
(true (dict :block "start")))))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-halt!
|
||||
(fn
|
||||
@@ -486,11 +505,6 @@
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define hs-select! (fn (target) (host-call target "select" (list))))
|
||||
|
||||
(define
|
||||
@@ -619,6 +633,10 @@
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-query-last
|
||||
(fn
|
||||
@@ -627,12 +645,9 @@
|
||||
((all (dom-query-all (dom-body) sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-last
|
||||
(fn
|
||||
@@ -640,8 +655,7 @@
|
||||
(let
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -659,7 +673,7 @@
|
||||
((= signal "hs-continue") (do-repeat (+ i 1)))
|
||||
(true (do-repeat (+ i 1))))))))
|
||||
(do-repeat 0)))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-repeat-forever
|
||||
(fn
|
||||
@@ -675,7 +689,9 @@
|
||||
((= signal "hs-continue") (do-forever))
|
||||
(true (do-forever))))))
|
||||
(do-forever)))
|
||||
;; Method dispatch — obj.method(args)
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-repeat-while
|
||||
(fn
|
||||
@@ -688,9 +704,7 @@
|
||||
((= signal "hs-break") nil)
|
||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||
(true (hs-repeat-while cond-fn thunk)))))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-repeat-until
|
||||
(fn
|
||||
@@ -702,13 +716,13 @@
|
||||
((= signal "hs-continue")
|
||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
(fn-body collection)
|
||||
(let
|
||||
((items (cond ((list? collection) collection) ((dict? collection) (keys collection)) ((nil? collection) (list)) (true (list)))))
|
||||
((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
|
||||
(define
|
||||
do-loop
|
||||
(fn
|
||||
@@ -722,7 +736,7 @@
|
||||
((= signal "hs-continue") (do-loop (rest remaining)))
|
||||
(true (do-loop (rest remaining))))))))
|
||||
(do-loop items))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by
|
||||
(begin
|
||||
(define
|
||||
hs-append
|
||||
@@ -750,7 +764,7 @@
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend" (str value)))
|
||||
(true nil)))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-sender
|
||||
(fn
|
||||
@@ -758,7 +772,7 @@
|
||||
(let
|
||||
((detail (host-get event "detail")))
|
||||
(if detail (host-get detail "sender") nil))))
|
||||
;; Collection: sorted by descending
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-host-to-sx
|
||||
(fn
|
||||
@@ -812,7 +826,7 @@
|
||||
(dict-set! out k (hs-host-to-sx (host-get v k))))
|
||||
(host-call (host-global "Object") "keys" v))
|
||||
out)))))))))))
|
||||
;; Collection: split by
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
@@ -822,7 +836,7 @@
|
||||
(let
|
||||
((raw (perform (list "io-fetch" url fmt))))
|
||||
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-json-escape
|
||||
(fn
|
||||
@@ -958,11 +972,17 @@
|
||||
((= type-name "Selector") (str value))
|
||||
((= type-name "Fragment") value)
|
||||
((= type-name "Values") (hs-as-values value))
|
||||
((= type-name "Keys") (if (dict? value) (sort (keys value)) value))
|
||||
((= type-name "Keys")
|
||||
(if
|
||||
(dict? value)
|
||||
(sort (filter (fn (k) (not (= k "_order"))) (keys value)))
|
||||
value))
|
||||
((= type-name "Entries")
|
||||
(if
|
||||
(dict? value)
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
(let
|
||||
((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
|
||||
(map (fn (k) (list k (get value k))) ks))
|
||||
value))
|
||||
((= type-name "Reversed") (if (list? value) (reverse value) value))
|
||||
((= type-name "Unique")
|
||||
@@ -998,7 +1018,9 @@
|
||||
((= type-name "Map")
|
||||
(if
|
||||
(dict? value)
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
(let
|
||||
((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
|
||||
(map (fn (k) (list k (get value k))) ks))
|
||||
value))
|
||||
(true value))))
|
||||
|
||||
@@ -2012,11 +2034,20 @@
|
||||
(fn
|
||||
(pairs)
|
||||
(let
|
||||
((d {}))
|
||||
((d {}) (order (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||
(fn
|
||||
(pair)
|
||||
(let
|
||||
((k (first pair)))
|
||||
(do
|
||||
(when
|
||||
(not (dict-has? d k))
|
||||
(set! order (append order (list k))))
|
||||
(dict-set! d k (nth pair 1)))))
|
||||
pairs)
|
||||
(when (not (empty? order)) (dict-set! d "_order" order))
|
||||
d))))
|
||||
|
||||
(define
|
||||
|
||||
@@ -337,14 +337,33 @@
|
||||
(ast)
|
||||
(let
|
||||
((var-name (nth ast 1))
|
||||
(raw-coll (hs-to-sx (nth ast 2)))
|
||||
(collection
|
||||
(raw-coll-ast (nth ast 2))
|
||||
(where-cond
|
||||
(if
|
||||
(and
|
||||
(list? raw-coll-ast)
|
||||
(= (first raw-coll-ast) (quote coll-where)))
|
||||
(hs-to-sx (nth raw-coll-ast 2))
|
||||
nil))
|
||||
(inner-coll-ast
|
||||
(if where-cond (nth raw-coll-ast 1) raw-coll-ast))
|
||||
(raw-coll (hs-to-sx inner-coll-ast))
|
||||
(safe-coll
|
||||
(if
|
||||
(symbol? raw-coll)
|
||||
(list
|
||||
(quote hs-safe-call)
|
||||
(list (quote fn) (list) raw-coll))
|
||||
(quote cek-try)
|
||||
(list (quote fn) (list) raw-coll)
|
||||
(list (quote fn) (list (quote _e)) nil))
|
||||
raw-coll))
|
||||
(collection
|
||||
(if
|
||||
where-cond
|
||||
(list
|
||||
(quote filter)
|
||||
(list (quote fn) (list (make-symbol var-name)) where-cond)
|
||||
safe-coll)
|
||||
safe-coll))
|
||||
(body (hs-to-sx (nth ast 3))))
|
||||
(if
|
||||
(and (> (len ast) 4) (= (nth ast 4) :index))
|
||||
@@ -839,7 +858,7 @@
|
||||
(list (quote hs-beep) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote array-index))
|
||||
(list
|
||||
(quote nth)
|
||||
(quote hs-index)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote array-slice))
|
||||
|
||||
@@ -244,7 +244,8 @@
|
||||
((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))))))))
|
||||
(obj-collect
|
||||
(append acc (list (list key value))))))))))
|
||||
(list (quote object-literal) (obj-collect (list)))))
|
||||
((and (= typ "op") (= val "\\"))
|
||||
(do
|
||||
|
||||
@@ -387,6 +387,21 @@
|
||||
|
||||
;; Fetch a URL, parse response according to format.
|
||||
;; (hs-fetch url format) — format is "json" | "text" | "html"
|
||||
(define
|
||||
hs-index
|
||||
(fn
|
||||
(obj key)
|
||||
(cond
|
||||
((nil? obj) nil)
|
||||
((dict? obj) (get obj key))
|
||||
((list? obj) (nth obj key))
|
||||
((string? obj) (nth obj key))
|
||||
(true (host-get obj key)))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
(define
|
||||
hs-put-at!
|
||||
(fn
|
||||
@@ -398,17 +413,20 @@
|
||||
(= pos "start")
|
||||
(cons value target)
|
||||
(append target (list value))))
|
||||
(true
|
||||
(cond
|
||||
((hs-element? target) (do (hs-put! value pos target) target))
|
||||
(true
|
||||
(do
|
||||
(cond
|
||||
((= pos "end") (host-call target "push" value))
|
||||
((= pos "start") (host-call target "unshift" value)))
|
||||
target)))))
|
||||
target)))))))
|
||||
|
||||
;; ── Type coercion ───────────────────────────────────────────────
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
|
||||
;; Coerce a value to a type by name.
|
||||
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
(define
|
||||
hs-dict-without
|
||||
(fn
|
||||
@@ -429,27 +447,27 @@
|
||||
(host-call (host-global "Reflect") "deleteProperty" out key)
|
||||
out)))))
|
||||
|
||||
;; ── Object creation ─────────────────────────────────────────────
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
;; Make a new object of a given type.
|
||||
;; (hs-make type-name) — creates empty object/collection
|
||||
;; Install a behavior on an element.
|
||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||
;; (hs-install behavior-fn me ...args)
|
||||
(define
|
||||
hs-set-on!
|
||||
(fn
|
||||
(props target)
|
||||
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
|
||||
|
||||
;; ── Behavior installation ───────────────────────────────────────
|
||||
|
||||
;; Install a behavior on an element.
|
||||
;; A behavior is a function that takes (me ...params) and sets up features.
|
||||
;; (hs-install behavior-fn me ...args)
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
;; ── Measurement ─────────────────────────────────────────────────
|
||||
|
||||
;; Measure an element's bounding rect, store as local variables.
|
||||
;; Returns a dict with x, y, width, height, top, left, right, bottom.
|
||||
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
(define
|
||||
hs-scroll!
|
||||
(fn
|
||||
@@ -462,10 +480,11 @@
|
||||
((= position "bottom") (dict :block "end"))
|
||||
(true (dict :block "start")))))))
|
||||
|
||||
;; Return the current text selection as a string. In the browser this is
|
||||
;; `window.getSelection().toString()`. In the mock test runner, a test
|
||||
;; setup stashes the desired selection text at `window.__test_selection`
|
||||
;; and the fallback path returns that so tests can assert on the result.
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define
|
||||
hs-halt!
|
||||
(fn
|
||||
@@ -486,11 +505,6 @@
|
||||
(host-call ev "stopPropagation")))))
|
||||
(when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
|
||||
|
||||
|
||||
;; ── Transition ──────────────────────────────────────────────────
|
||||
|
||||
;; Transition a CSS property to a value, optionally with duration.
|
||||
;; (hs-transition target prop value duration)
|
||||
(define hs-select! (fn (target) (host-call target "select" (list))))
|
||||
|
||||
(define
|
||||
@@ -619,6 +633,10 @@
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define
|
||||
hs-query-last
|
||||
(fn
|
||||
@@ -627,12 +645,9 @@
|
||||
((all (dom-query-all (dom-body) sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-last
|
||||
(fn
|
||||
@@ -640,8 +655,7 @@
|
||||
(let
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -659,7 +673,7 @@
|
||||
((= signal "hs-continue") (do-repeat (+ i 1)))
|
||||
(true (do-repeat (+ i 1))))))))
|
||||
(do-repeat 0)))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-repeat-forever
|
||||
(fn
|
||||
@@ -675,7 +689,9 @@
|
||||
((= signal "hs-continue") (do-forever))
|
||||
(true (do-forever))))))
|
||||
(do-forever)))
|
||||
;; Method dispatch — obj.method(args)
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-repeat-while
|
||||
(fn
|
||||
@@ -688,9 +704,7 @@
|
||||
((= signal "hs-break") nil)
|
||||
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
|
||||
(true (hs-repeat-while cond-fn thunk)))))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-repeat-until
|
||||
(fn
|
||||
@@ -702,13 +716,13 @@
|
||||
((= signal "hs-continue")
|
||||
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
|
||||
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-for-each
|
||||
(fn
|
||||
(fn-body collection)
|
||||
(let
|
||||
((items (cond ((list? collection) collection) ((dict? collection) (keys collection)) ((nil? collection) (list)) (true (list)))))
|
||||
((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
|
||||
(define
|
||||
do-loop
|
||||
(fn
|
||||
@@ -722,7 +736,7 @@
|
||||
((= signal "hs-continue") (do-loop (rest remaining)))
|
||||
(true (do-loop (rest remaining))))))))
|
||||
(do-loop items))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
;; Collection: sorted by
|
||||
(begin
|
||||
(define
|
||||
hs-append
|
||||
@@ -750,7 +764,7 @@
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend" (str value)))
|
||||
(true nil)))))
|
||||
;; Collection: sorted by
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-sender
|
||||
(fn
|
||||
@@ -758,7 +772,7 @@
|
||||
(let
|
||||
((detail (host-get event "detail")))
|
||||
(if detail (host-get detail "sender") nil))))
|
||||
;; Collection: sorted by descending
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-host-to-sx
|
||||
(fn
|
||||
@@ -812,7 +826,7 @@
|
||||
(dict-set! out k (hs-host-to-sx (host-get v k))))
|
||||
(host-call (host-global "Object") "keys" v))
|
||||
out)))))))))))
|
||||
;; Collection: split by
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-fetch
|
||||
(fn
|
||||
@@ -822,7 +836,7 @@
|
||||
(let
|
||||
((raw (perform (list "io-fetch" url fmt))))
|
||||
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-json-escape
|
||||
(fn
|
||||
@@ -958,11 +972,17 @@
|
||||
((= type-name "Selector") (str value))
|
||||
((= type-name "Fragment") value)
|
||||
((= type-name "Values") (hs-as-values value))
|
||||
((= type-name "Keys") (if (dict? value) (sort (keys value)) value))
|
||||
((= type-name "Keys")
|
||||
(if
|
||||
(dict? value)
|
||||
(sort (filter (fn (k) (not (= k "_order"))) (keys value)))
|
||||
value))
|
||||
((= type-name "Entries")
|
||||
(if
|
||||
(dict? value)
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
(let
|
||||
((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
|
||||
(map (fn (k) (list k (get value k))) ks))
|
||||
value))
|
||||
((= type-name "Reversed") (if (list? value) (reverse value) value))
|
||||
((= type-name "Unique")
|
||||
@@ -998,7 +1018,9 @@
|
||||
((= type-name "Map")
|
||||
(if
|
||||
(dict? value)
|
||||
(map (fn (k) (list k (get value k))) (keys value))
|
||||
(let
|
||||
((ks (if (dict-has? value "_order") (get value "_order") (filter (fn (k) (not (= k "_order"))) (keys value)))))
|
||||
(map (fn (k) (list k (get value k))) ks))
|
||||
value))
|
||||
(true value))))
|
||||
|
||||
@@ -2012,11 +2034,20 @@
|
||||
(fn
|
||||
(pairs)
|
||||
(let
|
||||
((d {}))
|
||||
((d {}) (order (list)))
|
||||
(do
|
||||
(for-each
|
||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||
(fn
|
||||
(pair)
|
||||
(let
|
||||
((k (first pair)))
|
||||
(do
|
||||
(when
|
||||
(not (dict-has? d k))
|
||||
(set! order (append order (list k))))
|
||||
(dict-set! d k (nth pair 1)))))
|
||||
pairs)
|
||||
(when (not (empty? order)) (dict-set! d "_order" order))
|
||||
d))))
|
||||
|
||||
(define
|
||||
|
||||
Reference in New Issue
Block a user