coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

HS: ask/answer + prompt/confirm mock (+4 tests)

Browse Source 
Wire up the `ask` and `answer` commands end-to-end:

- tokenizer.sx: register `ask` and `answer` as hs-keywords.

- parser.sx: cmd-kw? gains both; parse-cmd dispatches to new
  parse-ask-cmd (emits `(ask MSG)`) and parse-answer-cmd, which
  reads `answer MSG [with YES or NO]`. The with/or pair reads
  yes/no via parse-atom — parse-expr would collapse
  `"Yes" or "No"` into `(or "Yes" "No")` before match-kw "or"
  could fire. The no-`with` form emits `(answer-alert MSG)`.

- compiler.sx: three new cond branches (ask, answer, answer-alert)
  compile to a let that binds __hs-a, sets `the-result` and `it`,
  and returns the value — so `then put it into ...` works.

- runtime.sx: hs-ask / hs-answer / hs-answer-alert call
  window.prompt / confirm / alert via host-call + host-global.

- tests/hs-run-filtered.js: test-name-keyed globalThis.{alert,
  confirm,prompt}; __currentHsTestName is updated before each
  test. Host-set! for innerHTML/textContent now coerces JS
  null → "null" (browser behaviour) so `prompt → null` →
  `put it into #out` renders literal text "null", which the
  fourth test depends on.

Suite hs-upstream-askAnswer: 1/5 -> 5/5.
Smoke 0-195: 166/195 -> 170/195.
This commit is contained in:
giles
2026-04-24 14:08:25 +00:00
parent 30fca2dd19
commit 6c1da9212a
11 changed files with 244 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
lib/hyperscript/compiler.sx
View File

@@ -1757,6 +1757,39 @@
(list (quote hs-settle) (quote me)))
((= head (quote go))
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
((= head (quote ask))
(let
((val (list (quote hs-ask) (hs-to-sx (nth ast 1)))))
(list
(quote let)
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote answer))
(let
((val (list (quote hs-answer) (hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 2)) (hs-to-sx (nth ast 3)))))
(list
(quote let)
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote answer-alert))
(let
((val (list (quote hs-answer-alert) (hs-to-sx (nth ast 1)))))
(list
(quote let)
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote __get-cmd))
(let
((val (hs-to-sx (nth ast 1))))

25
lib/hyperscript/parser.sx
View File

@@ -1717,6 +1717,23 @@
(ca-collect (append acc (list arg)))))))
(ca-collect (list))))
(define parse-call-cmd (fn () (parse-expr)))
(define parse-ask-cmd (fn () (list (quote ask) (parse-expr))))
(define
parse-answer-cmd
(fn
()
(let
((msg (parse-atom)))
(if
(match-kw "with")
(let
((yes (parse-atom)))
(begin
(match-kw "or")
(let
((no-val (parse-atom)))
(list (quote answer) msg yes no-val))))
(list (quote answer-alert) msg)))))
(define parse-get-cmd (fn () (list (quote __get-cmd) (parse-expr))))
(define
parse-take-cmd
@@ -2399,6 +2416,10 @@
(do (adv!) (parse-take-cmd)))
((and (= typ "keyword") (= val "pick"))
(do (adv!) (parse-pick-cmd)))
((and (= typ "keyword") (= val "ask"))
(do (adv!) (parse-ask-cmd)))
((and (= typ "keyword") (= val "answer"))
(do (adv!) (parse-answer-cmd)))
((and (= typ "keyword") (= val "settle"))
(do (adv!) (list (quote settle))))
((and (= typ "keyword") (= val "go"))
@@ -2504,7 +2525,9 @@
(= v "morph")
(= v "open")
(= v "close")
(= v "pick"))))
(= v "pick")
(= v "ask")
(= v "answer"))))
(define
cl-collect
(fn

74
lib/hyperscript/runtime.sx
View File

@@ -468,6 +468,35 @@
;; `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-ask
(fn
(msg)
(let
((w (host-global "window")))
(if w (host-call w "prompt" msg) nil))))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-answer
(fn
(msg yes-val no-val)
(let
((w (host-global "window")))
(if w (if (host-call w "confirm" msg) yes-val no-val) no-val))))
(define
hs-answer-alert
(fn
(msg)
(let
((w (host-global "window")))
(if w (begin (host-call w "alert" msg) nil) nil))))
(define
hs-scroll!
(fn
@@ -480,11 +509,6 @@
((= position "bottom") (dict :block "end"))
(true (dict :block "start")))))))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-halt!
(fn
@@ -619,6 +643,10 @@
(hs-query-all sel)
(host-call target "querySelectorAll" sel))))
(define
hs-list-set
(fn
@@ -628,15 +656,12 @@
(define
hs-to-number
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; DOM query stub — sandbox returns empty list
(define
hs-query-last
(fn
@@ -644,10 +669,11 @@
(let
((all (dom-query-all (dom-body) sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Method dispatch — obj.method(args)
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define
hs-last
(fn
@@ -655,7 +681,7 @@
(let
((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; DOM query stub — sandbox returns empty list
;; Property-based is — check obj.key truthiness
(define
hs-repeat-times
(fn
@@ -673,7 +699,7 @@
((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1))))))))
(do-repeat 0)))
;; Method dispatch — obj.method(args)
;; Array slicing (inclusive both ends)
(define
hs-repeat-forever
(fn
@@ -689,9 +715,7 @@
((= signal "hs-continue") (do-forever))
(true (do-forever))))))
(do-forever)))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
;; Collection: sorted by
(define
hs-repeat-while
(fn
@@ -704,7 +728,7 @@
((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk)))))))
;; Property-based is — check obj.key truthiness
;; Collection: sorted by descending
(define
hs-repeat-until
(fn
@@ -716,7 +740,7 @@
((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
;; Array slicing (inclusive both ends)
;; Collection: split by
(define
hs-for-each
(fn
@@ -736,7 +760,7 @@
((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining))))))))
(do-loop items))))
;; Collection: sorted by
;; Collection: joined by
(begin
(define
hs-append
@@ -764,7 +788,7 @@
((hs-element? target)
(dom-insert-adjacent-html target "beforeend" (str value)))
(true nil)))))
;; Collection: sorted by descending
(define
hs-sender
(fn
@@ -772,7 +796,7 @@
(let
((detail (host-get event "detail")))
(if detail (host-get detail "sender") nil))))
;; Collection: split by
(define
hs-host-to-sx
(fn
@@ -826,7 +850,7 @@
(dict-set! out k (hs-host-to-sx (host-get v k))))
(host-call (host-global "Object") "keys" v))
out)))))))))))
;; Collection: joined by
(define
hs-fetch
(fn

4
lib/hyperscript/tokenizer.sx
View File

@@ -185,7 +185,9 @@
"dom"
"morph"
"using"
"giving"))
"giving"
"ask"
"answer"))
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))