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

HS: return/guard, repeat while/until, if-then fix, script extraction

Browse Source 
Parser: if-then consumes 'then' keyword before parsing then-body.
Compiler: return→raise, def→guard, repeat while/until dispatch.
Runtime: hs-repeat-while, hs-repeat-until.
Test gen: script block extraction for def functions.
repeat suite: 10→13/30.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-16 21:33:55 +00:00
parent 97818c6de1
commit 76f7e3b68a
9 changed files with 396 additions and 1568 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
lib/hyperscript/compiler.sx
View File

@@ -237,6 +237,20 @@
(quote hs-repeat-times)
mode
(list (quote fn) (list) body)))
((and (list? mode) (= (first mode) (quote while)))
(let
((cond-expr (hs-to-sx (nth mode 1))))
(list
(quote hs-repeat-while)
(list (quote fn) (list) cond-expr)
(list (quote fn) (list) body))))
((and (list? mode) (= (first mode) (quote until)))
(let
((cond-expr (hs-to-sx (nth mode 1))))
(list
(quote hs-repeat-until)
(list (quote fn) (list) cond-expr)
(list (quote fn) (list) body))))
(true
(list
(quote hs-repeat-times)
@@ -1035,7 +1049,15 @@
((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 return))
(let
((val (nth ast 1)))
(if
(nil? val)
(list (quote raise) (list (quote list) "hs-return" nil))
(list
(quote raise)
(list (quote list) "hs-return" (hs-to-sx val))))))
((= head (quote throw))
(list (quote raise) (hs-to-sx (nth ast 1))))
((= head (quote settle))
@@ -1106,13 +1128,41 @@
(quote hs-init)
(list (quote fn) (list) (hs-to-sx (nth ast 1)))))
((= head (quote def))
(list
(quote define)
(make-symbol (nth ast 1))
(let
((body (hs-to-sx (nth ast 3)))
(params
(map
(fn
(p)
(if
(and (list? p) (= (first p) (quote ref)))
(make-symbol (nth p 1))
(make-symbol p)))
(nth ast 2))))
(list
(quote fn)
(map make-symbol (nth ast 2))
(hs-to-sx (nth ast 3)))))
(quote define)
(make-symbol (nth ast 1))
(list
(quote fn)
params
(list
(quote guard)
(list
(quote _e)
(list
(quote true)
(list
(quote if)
(list
(quote and)
(list (quote list?) (quote _e))
(list
(quote =)
(list (quote first) (quote _e))
"hs-return"))
(list (quote nth) (quote _e) 1)
(list (quote raise) (quote _e)))))
body)))))
((= head (quote behavior)) (emit-behavior ast))
((= head (quote sx-eval))
(let