From f200418d914a2c8dad557f433946744a40ff5ace Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 20 Apr 2026 17:58:58 +0000 Subject: [PATCH] =?UTF-8?q?HS:=20break/continue/until=20=E2=80=94=20loop?= =?UTF-8?q?=20control=20flow=20via=20guard/raise?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Parser: - Add break, continue, exit/halt as parsed commands - Handle bottom-tested repeat: repeat until - Handle bottom-tested repeat: repeat while Compiler: - break → (raise "hs-break"), continue → (raise "hs-continue") - repeat-until/repeat-while → hs-repeat-until/hs-repeat-while - for loops use hs-for-each (break/continue aware) instead of for-each Runtime: - hs-repeat-times, hs-repeat-forever, hs-repeat-while: wrap body in guard to catch hs-break (exit loop) and hs-continue (next iteration) - Add hs-repeat-until: bottom-tested do-until loop with guard - Add hs-for-each: break/continue aware iteration over lists Co-Authored-By: Claude Opus 4.6 (1M context) --- lib/hyperscript/compiler.sx | 16 +++++- lib/hyperscript/parser.sx | 23 +++++++-- lib/hyperscript/runtime.sx | 99 ++++++++++++++++++++++++++++--------- 3 files changed, 112 insertions(+), 26 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 86f80029..b5d95f82 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -274,7 +274,7 @@ body) collection) (list - (quote for-each) + (quote hs-for-each) (list (quote fn) (list (make-symbol var-name)) body) collection))))) (define @@ -1105,6 +1105,16 @@ to-val (if dur (hs-to-sx dur) nil)))) ((= head (quote repeat)) (emit-repeat ast)) + ((= head (quote repeat-until)) + (list + (quote hs-repeat-until) + (list (quote fn) (list) (hs-to-sx (nth ast 1))) + (list (quote fn) (list) (hs-to-sx (nth ast 2))))) + ((= head (quote repeat-while)) + (list + (quote hs-repeat-while) + (list (quote fn) (list) (hs-to-sx (nth ast 1))) + (list (quote fn) (list) (hs-to-sx (nth ast 2))))) ((= head (quote fetch)) (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2))) ((= head (quote fetch-gql)) @@ -1190,6 +1200,10 @@ (nth ast 1) (nth ast 2) (if (> (len ast) 3) (nth ast 3) nil))) + ((= head (quote break)) (list (quote raise) "hs-break")) + ((= head (quote continue)) + (list (quote raise) "hs-continue")) + ((= head (quote exit)) nil) ((= head (quote on)) (emit-on ast)) ((= head (quote init)) (list diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index f380944a..1137e7fc 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1325,9 +1325,20 @@ (let ((mode (cond ((match-kw "forever") (list (quote forever))) ((match-kw "while") (list (quote while) (parse-expr))) ((match-kw "until") (list (quote until) (parse-expr))) (true (let ((n (parse-expr))) (if (match-kw "times") (list (quote times) n) (list (quote forever)))))))) (let - ((body (parse-cmd-list))) - (match-kw "end") - (list (quote repeat) mode body))))))) + ((body (do (match-kw "then") (parse-cmd-list)))) + (cond + ((match-kw "until") + (let + ((cond-expr (parse-expr))) + (match-kw "end") + (list (quote repeat-until) cond-expr body))) + ((match-kw "while") + (let + ((cond-expr (parse-expr))) + (match-kw "end") + (list (quote repeat-while) cond-expr body))) + (true + (do (match-kw "end") (list (quote repeat) mode body)))))))))) (define parse-fetch-cmd (fn @@ -1885,6 +1896,12 @@ (do (adv!) (parse-open-cmd))) ((and (= typ "keyword") (= val "close")) (do (adv!) (parse-close-cmd))) + ((and (= typ "keyword") (= val "break")) + (do (adv!) (list (quote break)))) + ((and (= typ "keyword") (= val "continue")) + (do (adv!) (list (quote continue)))) + ((and (= typ "keyword") (or (= val "exit") (= val "halt"))) + (do (adv!) (list (quote exit)))) (true (parse-expr)))))) (define parse-cmd-list diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 380353bb..6f8ac0ae 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -320,21 +320,76 @@ (n thunk) (define do-repeat - (fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1)))))) + (fn + (i) + (when + (< i n) + (let + ((signal (guard (e (true (str e))) (do (thunk) nil)))) + (cond + ((= signal "hs-break") nil) + ((= signal "hs-continue") (do-repeat (+ i 1))) + (true (do-repeat (+ i 1)))))))) (do-repeat 0))) (define hs-repeat-forever (fn (thunk) - (define do-forever (fn () (thunk) (do-forever))) + (define + do-forever + (fn + () + (let + ((signal (guard (e (true (str e))) (do (thunk) nil)))) + (cond + ((= signal "hs-break") nil) + ((= signal "hs-continue") (do-forever)) + (true (do-forever)))))) (do-forever))) (define hs-repeat-while (fn (cond-fn thunk) - (when (cond-fn) (thunk) (hs-repeat-while cond-fn thunk)))) + (when + (cond-fn) + (let + ((signal (guard (e (true (str e))) (do (thunk) nil)))) + (cond + ((= signal "hs-break") nil) + ((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) + (true (hs-repeat-while cond-fn thunk))))))) + +(define + hs-repeat-until + (fn + (cond-fn thunk) + (let + ((signal (guard (e (true (str e))) (do (thunk) nil)))) + (cond + ((= signal "hs-break") nil) + ((= signal "hs-continue") + (if (cond-fn) nil (hs-repeat-until cond-fn thunk))) + (true (if (cond-fn) nil (hs-repeat-until cond-fn thunk))))))) + +(define + hs-for-each + (fn + (fn-body collection) + (define + do-loop + (fn + (items) + (when + (not (empty? items)) + (let + ((signal (guard (e (true (str e))) (do (fn-body (first items)) nil)))) + (cond + ((= signal "hs-break") nil) + ((= signal "hs-continue") (do-loop (rest items))) + (true (do-loop (rest items)))))))) + (when (list? collection) (do-loop collection)))) (define hs-fetch @@ -342,6 +397,10 @@ (url format) (perform (list "io-fetch" url (if format format "text"))))) + + + + (define hs-coerce (fn @@ -440,11 +499,8 @@ ((list? b) (cons a b)) ((or (string? a) (string? b)) (str a b)) (true (+ a b))))) - - - - - +;; ── Sandbox/test runtime additions ────────────────────────────── +;; Property access — dot notation and .length (define hs-make (fn @@ -455,14 +511,15 @@ ((= type-name "Set") (list)) ((= type-name "Map") (dict)) (true (dict))))) - +;; DOM query stub — sandbox returns empty list (define hs-install (fn (behavior-fn) (behavior-fn me))) -;; ── Sandbox/test runtime additions ────────────────────────────── -;; Property access — dot notation and .length +;; Method dispatch — obj.method(args) (define hs-measure (fn (target) (perform (list (quote io-measure) target)))) -;; DOM query stub — sandbox returns empty list + +;; ── 0.9.90 features ───────────────────────────────────────────── +;; beep! — debug logging, returns value unchanged (define hs-transition (fn @@ -475,7 +532,7 @@ (str prop " " (/ duration 1000) "s"))) (dom-set-style target prop value) (when duration (hs-settle target)))) -;; Method dispatch — obj.method(args) +;; Property-based is — check obj.key truthiness (define hs-transition-from (fn @@ -489,9 +546,7 @@ (str prop " " (/ duration 1000) "s"))) (dom-set-style target prop (str to-val)) (when duration (hs-settle target)))) - -;; ── 0.9.90 features ───────────────────────────────────────────── -;; beep! — debug logging, returns value unchanged +;; Array slicing (inclusive both ends) (define hs-type-check (fn @@ -511,31 +566,31 @@ (= (host-typeof value) "element") (= (host-typeof value) "text"))) (true (= (host-typeof value) (downcase type-name))))))) -;; Property-based is — check obj.key truthiness +;; Collection: sorted by (define hs-type-check-strict (fn (value type-name) (if (nil? value) false (hs-type-check value type-name)))) -;; Array slicing (inclusive both ends) +;; Collection: sorted by descending (define hs-strict-eq (fn (a b) (and (= (type-of a) (type-of b)) (= a b)))) -;; Collection: sorted by +;; Collection: split by (define hs-eq-ignore-case (fn (a b) (= (downcase (str a)) (downcase (str b))))) -;; Collection: sorted by descending +;; Collection: joined by (define hs-starts-with-ic? (fn (str prefix) (starts-with? (downcase str) (downcase prefix)))) -;; Collection: split by + (define hs-contains-ignore-case? (fn (haystack needle) (contains? (downcase (str haystack)) (downcase (str needle))))) -;; Collection: joined by + (define hs-falsy? (fn