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

js-on-sx: switch/case/default/break

Browse Source 
Parser: jp-parse-switch-stmt + jp-parse-switch-cases + jp-parse-switch-body.
AST: (js-switch discr (("case" val body) ("default" nil body) ...)).

Transpile: wraps body in (call/cc (fn (__break__) ...)). Each case
clause becomes (when (or __matched__ (js-strict-eq discr val))
(set! __matched__ true) body). Fall-through works naturally via
__matched__. Default appended as (when (not __matched__) body).

363/365 unit (+6), 148/148 slice unchanged.
This commit is contained in:
giles
2026-04-23 21:04:22 +00:00
parent 275d2ecbae
commit 9d3e54029a
4 changed files with 167 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
lib/js/parser.sx
View File

@@ -1015,6 +1015,63 @@
((e (jp-parse-assignment st)))
(do (jp-eat-semi st) (list (quote js-throw) e))))))
(define
jp-parse-switch-stmt
(fn
(st)
(jp-advance! st)
(jp-expect! st "punct" "(")
(let
((disc (jp-parse-assignment st)))
(jp-expect! st "punct" ")")
(jp-expect! st "punct" "{")
(let
((cases (list)))
(jp-parse-switch-cases st cases)
(jp-expect! st "punct" "}")
(list (quote js-switch) disc cases)))))
(define
jp-parse-switch-cases
(fn
(st cases)
(cond
((jp-at? st "punct" "}") nil)
((jp-at? st "keyword" "case")
(do
(jp-advance! st)
(let
((val (jp-parse-assignment st)))
(jp-expect! st "punct" ":")
(let
((body (list)))
(jp-parse-switch-body st body)
(append! cases (list "case" val body))
(jp-parse-switch-cases st cases)))))
((jp-at? st "keyword" "default")
(do
(jp-advance! st)
(jp-expect! st "punct" ":")
(let
((body (list)))
(jp-parse-switch-body st body)
(append! cases (list "default" nil body))
(jp-parse-switch-cases st cases))))
(else (error "switch: expected case or default")))))
(define
jp-parse-switch-body
(fn
(st body)
(cond
((jp-at? st "punct" "}") nil)
((jp-at? st "keyword" "case") nil)
((jp-at? st "keyword" "default") nil)
(else
(begin
(append! body (jp-parse-stmt st))
(jp-parse-switch-body st body))))))
(define
jp-parse-try-stmt
(fn
@@ -1055,6 +1112,7 @@
((and (jp-at? st "keyword" "async") (= (get (jp-peek-at st 1) :type) "keyword") (= (get (jp-peek-at st 1) :value) "function"))
(do (jp-advance! st) (jp-parse-async-function-decl st)))
((jp-at? st "keyword" "function") (jp-parse-function-decl st))
((jp-at? st "keyword" "switch") (jp-parse-switch-stmt st))
(else
(let
((e (jp-parse-assignment st)))

22
lib/js/test.sh
View File

@@ -937,6 +937,20 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 1505)
(eval "(js-eval \"Array.of(1,2,3).length\")")
;; ── Phase 11.switch: switch/case/default/break ──────────────────
(epoch 1600)
(eval "(js-eval \"var r=0; switch(1){case 1: r=10; break;} r\")")
(epoch 1601)
(eval "(js-eval \"var r=0; switch(2){case 1: r=10; break; case 2: r=20; break;} r\")")
(epoch 1602)
(eval "(js-eval \"var r=0; switch(9){case 1: r=10; break; default: r=99;} r\")")
(epoch 1603)
(eval "(js-eval \"var r=0; switch(1){case 1: case 2: r=12; break;} r\")")
(epoch 1604)
(eval "(js-eval \"var r=''; switch('a'){case 'a': r='yes'; break;} r\")")
(epoch 1605)
(eval "(js-eval \"var r=0; switch(1){case 1: r=10; case 2: r=20; break;} r\")")
EPOCHS
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -1436,6 +1450,14 @@ check 1503 "Array.isArray yes" 'true'
check 1504 "Array.isArray no" 'false'
check 1505 "Array.of length" '3'
# ── Phase 11.switch ─────────────────────────────────────────────
check 1600 "switch case 1 match" '10'
check 1601 "switch case 2 match" '20'
check 1602 "switch default" '99'
check 1603 "switch fallthrough stops on break" '12'
check 1604 "switch on string" '"yes"'
check 1605 "switch fallthrough chains" '20'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "✓ $PASS/$TOTAL JS-on-SX tests passed"

85
lib/js/transpile.sx
View File

@@ -105,6 +105,8 @@
(js-transpile-postfix (nth ast 1) (nth ast 2)))
((js-tag? ast "js-prefix")
(js-transpile-prefix (nth ast 1) (nth ast 2)))
((js-tag? ast "js-switch")
(js-transpile-switch (nth ast 1) (nth ast 2)))
((js-tag? ast "js-new")
(js-transpile-new (nth ast 1) (nth ast 2)))
((js-tag? ast "js-class")
@@ -558,6 +560,89 @@
(js-sym "__js_old__"))))
(else (error "js-transpile-postfix: unsupported target"))))))
(define
js-transpile-switch
(fn
(discr cases)
(let
((discr-sym (js-sym "__discr__"))
(matched-sym (js-sym "__matched__"))
(break-sym (js-sym "__break__")))
(list
(js-sym "call/cc")
(list
(js-sym "fn")
(list break-sym)
(list
(js-sym "let")
(list
(list discr-sym (js-transpile discr))
(list matched-sym false))
(js-transpile-switch-clauses cases discr-sym matched-sym)))))))
(define
js-transpile-switch-clauses
(fn
(cases discr-sym matched-sym)
(let
((forms (list)))
(for-each
(fn
(c)
(let
((kind (nth c 0)))
(cond
((= kind "case")
(let
((val (nth c 1)) (body (nth c 2)))
(append!
forms
(list
(js-sym "when")
(list
(js-sym "or")
matched-sym
(list
(js-sym "js-strict-eq")
discr-sym
(js-transpile val)))
(js-transpile-switch-body-block matched-sym body)))))
((= kind "default")
(let
((body (nth c 2)))
(append!
forms
(list
(js-sym "when")
matched-sym
(js-transpile-switch-body-block matched-sym body))))))))
cases)
(let
((def-body nil))
(for-each
(fn
(c)
(when (= (nth c 0) "default") (set! def-body (nth c 2))))
cases)
(when
(not (= def-body nil))
(append!
forms
(list
(js-sym "when")
(list (js-sym "not") matched-sym)
(js-transpile-switch-body-block matched-sym def-body)))))
(cons (js-sym "begin") forms))))
(define
js-transpile-switch-body-block
(fn
(matched-sym body)
(let
((forms (list (list (js-sym "set!") matched-sym true))))
(for-each (fn (stmt) (append! forms (js-transpile stmt))) body)
(cons (js-sym "begin") forms))))
(define
js-param-sym
(fn