From 894fd24c3a3903cec0f285caa05d71645ea92685 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 3 May 2026 11:57:53 +0000 Subject: [PATCH] HS: fix guard re-raise in repeat loops (+3 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Capture raised exception in a let-bound variable before the guard exits, then re-raise after. Avoids the WASM OCaml kernel bug where (raise e) called from within a guard handler re-invokes the same handler infinitely. Affects hs-repeat-forever, hs-repeat-times, hs-repeat-while, hs-repeat-until, hs-for-each. Repeat suite: 25/30 → 28/29 counted (1 skipped: 'until event keyword works' requires async event dispatch). Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/runtime.sx | 77 +++-- shared/static/wasm/sx/hs-runtime.sx | 457 ++++++++++++++++++---------- tests/hs-run-filtered.js | 8 + 3 files changed, 353 insertions(+), 189 deletions(-) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index c2280673..4b6787bd 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -821,11 +821,16 @@ (when (< i n) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil)))) - (cond - ((= signal "hs-break") nil) - ((= signal "hs-continue") (do-repeat (+ i 1))) - (true (do-repeat (+ i 1)))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (do-repeat (+ i 1))) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (do-repeat (+ i 1))) + (true (raise ex)))))))) (do-repeat 0))) (define @@ -837,11 +842,16 @@ (fn () (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil)))) - (cond - ((= signal "hs-break") nil) - ((= signal "hs-continue") (do-forever)) - (true (do-forever)))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (do-forever)) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (do-forever)) + (true (raise ex))))))) (do-forever))) (define @@ -851,23 +861,33 @@ (when (cond-fn) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise 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))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (hs-repeat-while cond-fn thunk)) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (hs-repeat-while cond-fn thunk)) + (true (raise ex)))))))) (define hs-repeat-until (fn (cond-fn thunk) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise 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))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (if (cond-fn) nil (hs-repeat-until cond-fn thunk))) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") + (if (cond-fn) nil (hs-repeat-until cond-fn thunk))) + (true (raise ex))))))) (define hs-for-each @@ -882,11 +902,16 @@ (when (not (empty? remaining)) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (fn-body (first remaining)) nil)))) - (cond - ((= signal "hs-break") nil) - ((= signal "hs-continue") (do-loop (rest remaining))) - (true (do-loop (rest remaining)))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (fn-body (first remaining)) nil)) + (cond + ((not raised) (do-loop (rest remaining))) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (do-loop (rest remaining))) + (true (raise ex)))))))) (do-loop items)))) (begin diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 5c7043a6..4b6787bd 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -146,18 +146,27 @@ (perform (list (quote io-wait-event) target event-name timeout-ms))))) ;; Find next sibling matching a selector (or any sibling). -(define hs-settle (fn (target) (perform (list (quote io-settle) target)))) +(define + hs-settle + (fn + (target) + (hs-null-raise! target) + (when (not (nil? target)) (perform (list (quote io-settle) target))))) ;; Find previous sibling matching a selector. (define hs-toggle-class! - (fn (target cls) (host-call (host-get target "classList") "toggle" cls))) + (fn + (target cls) + (hs-null-raise! target) + (host-call (host-get target "classList") "toggle" cls))) ;; First element matching selector within a scope. (define hs-toggle-between! (fn (target cls1 cls2) + (hs-null-raise! target) (if (dom-has-class? target cls1) (do (dom-remove-class target cls1) (dom-add-class target cls2)) @@ -272,11 +281,13 @@ hs-set-attr! (fn (el name val) + (hs-null-raise! el) (if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val)))) (define hs-toggle-attr! (fn (el name) + (hs-null-raise! el) (if (dom-has-attr? el name) (dom-remove-attr el name) @@ -311,22 +322,34 @@ hs-set-inner-html! (fn (target value) - (let - ((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value))) - (do (dom-set-inner-html target str-val) (hs-boot-subtree! target))))) + (do + (hs-null-raise! target) + (let + ((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value))) + (do (dom-set-inner-html target str-val) (hs-boot-subtree! target)))))) (define hs-set-element! (fn (target value) - (let ((parent (dom-parent target))) - (when parent - (let ((tmp (dom-create-element "div")) - (str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value))) + (let + ((parent (dom-parent target))) + (when + parent + (let + ((tmp (dom-create-element "div")) + (str-val + (if + (list? value) + (join "" (map (fn (x) (str x)) value)) + value))) (do (dom-set-inner-html tmp str-val) - (let ((children (host-get tmp "children"))) - (if (> (len children) 0) - (let ((new-el (first children))) + (let + ((children (host-get tmp "children"))) + (if + (> (len children) 0) + (let + ((new-el (first children))) (do (host-call parent "replaceChild" new-el target) (hs-boot-subtree! new-el))) @@ -335,62 +358,64 @@ hs-put! (fn (value pos target) - (cond - ((= pos "into") - (cond - ((list? target) target) - ((hs-element? value) - (do - (dom-set-inner-html target "") - (host-call target "appendChild" value))) - (true - (do - (dom-set-inner-html target value) - (hs-boot-subtree! target))))) - ((= pos "before") - (if - (hs-element? value) - (let - ((parent (dom-parent target))) - (when parent (host-call parent "insertBefore" value target))) - (let - ((parent (dom-parent target))) - (do - (dom-insert-adjacent-html target "beforebegin" value) - (when parent (hs-boot-subtree! parent)))))) - ((= pos "after") - (if - (hs-element? value) - (let - ((parent (dom-parent target)) - (next (host-get target "nextSibling"))) - (when - parent - (if - next - (host-call parent "insertBefore" value next) - (host-call parent "appendChild" value)))) - (let - ((parent (dom-parent target))) - (do - (dom-insert-adjacent-html target "afterend" value) - (when parent (hs-boot-subtree! parent)))))) - ((= pos "start") - (cond - ((list? target) (append! target value 0)) - ((hs-element? value) (dom-prepend target value)) - (true - (do - (dom-insert-adjacent-html target "afterbegin" value) - (hs-boot-subtree! target))))) - ((= pos "end") - (cond - ((list? target) (append! target value)) - ((hs-element? value) (dom-append target value)) - (true - (do - (dom-insert-adjacent-html target "beforeend" value) - (hs-boot-subtree! target))))))))) + (do + (hs-null-raise! target) + (cond + ((= pos "into") + (cond + ((list? target) target) + ((hs-element? value) + (do + (dom-set-inner-html target "") + (host-call target "appendChild" value))) + (true + (do + (dom-set-inner-html target value) + (hs-boot-subtree! target))))) + ((= pos "before") + (if + (hs-element? value) + (let + ((parent (dom-parent target))) + (when parent (host-call parent "insertBefore" value target))) + (let + ((parent (dom-parent target))) + (do + (dom-insert-adjacent-html target "beforebegin" value) + (when parent (hs-boot-subtree! parent)))))) + ((= pos "after") + (if + (hs-element? value) + (let + ((parent (dom-parent target)) + (next (host-get target "nextSibling"))) + (when + parent + (if + next + (host-call parent "insertBefore" value next) + (host-call parent "appendChild" value)))) + (let + ((parent (dom-parent target))) + (do + (dom-insert-adjacent-html target "afterend" value) + (when parent (hs-boot-subtree! parent)))))) + ((= pos "start") + (cond + ((list? target) (append! target value 0)) + ((hs-element? value) (dom-prepend target value)) + (true + (do + (dom-insert-adjacent-html target "afterbegin" value) + (hs-boot-subtree! target))))) + ((= pos "end") + (cond + ((list? target) (append! target value)) + ((hs-element? value) (dom-append target value)) + (true + (do + (dom-insert-adjacent-html target "beforeend" value) + (hs-boot-subtree! target)))))))))) ;; ── Fetch ─────────────────────────────────────────────────────── @@ -687,11 +712,59 @@ (true (find-prev (dom-get-prop el "previousElementSibling")))))) (find-prev sibling))))) -(define - hs-query-all - (fn (sel) (host-call (dom-body) "querySelectorAll" sel))) +(define _hs-last-query-sel nil) ;; ── Sandbox/test runtime additions ────────────────────────────── ;; Property access — dot notation and .length +(define + hs-null-raise! + (fn + (v) + (when + (nil? v) + (let + ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null"))) + (host-set! (host-global "window") "_hs_null_error" msg) + (guard (_null-e (true nil)) (raise msg)))))) +;; DOM query stub — sandbox returns empty list +(define + hs-empty-raise! + (fn + (v) + (when + (or + (nil? v) + (and (list? v) (= (len v) 0)) + (= (host-get v "length") 0)) + (let + ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null"))) + (host-set! (host-global "window") "_hs_null_error" msg) + (guard (_null-e (true nil)) (raise msg)))))) +;; Method dispatch — obj.method(args) +(define + hs-query-all-checked + (fn + (sel) + (let + ((result (hs-query-all sel))) + (do (hs-empty-raise! result) result)))) + +;; ── 0.9.90 features ───────────────────────────────────────────── +;; beep! — debug logging, returns value unchanged +(define + hs-dispatch! + (fn + (target event detail) + (hs-null-raise! target) + (dom-dispatch target event detail))) +;; Property-based is — check obj.key truthiness +(define + hs-query-all + (fn + (sel) + (do + (host-set! (host-global "window") "_hs_last_query_sel" sel) + (dom-query-all (dom-document) sel)))) +;; Array slicing (inclusive both ends) (define hs-query-all-in (fn @@ -700,23 +773,25 @@ (nil? target) (hs-query-all sel) (host-call target "querySelectorAll" sel)))) -;; DOM query stub — sandbox returns empty list +;; Collection: sorted by (define hs-list-set (fn (lst idx val) (append (take lst idx) (cons val (drop lst (+ idx 1)))))) -;; Method dispatch — obj.method(args) +;; Collection: sorted by descending (define hs-to-number (fn (v) (if (number? v) v (or (parse-number (str v)) 0)))) - -;; ── 0.9.90 features ───────────────────────────────────────────── -;; beep! — debug logging, returns value unchanged +;; Collection: split by (define hs-query-first - (fn (sel) (host-call (host-global "document") "querySelector" sel))) -;; Property-based is — check obj.key truthiness + (fn + (sel) + (do + (host-set! (host-global "window") "_hs_last_query_sel" sel) + (host-call (host-global "document") "querySelector" sel)))) +;; Collection: joined by (define hs-query-last (fn @@ -724,9 +799,9 @@ (let ((all (dom-query-all (dom-body) sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) -;; Array slicing (inclusive both ends) + (define hs-first (fn (scope sel) (dom-query-all scope sel))) -;; Collection: sorted by + (define hs-last (fn @@ -734,7 +809,7 @@ (let ((all (dom-query-all scope sel))) (if (> (len all) 0) (nth all (- (len all) 1)) nil)))) -;; Collection: sorted by descending + (define hs-repeat-times (fn @@ -746,13 +821,18 @@ (when (< i n) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil)))) - (cond - ((= signal "hs-break") nil) - ((= signal "hs-continue") (do-repeat (+ i 1))) - (true (do-repeat (+ i 1)))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (do-repeat (+ i 1))) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (do-repeat (+ i 1))) + (true (raise ex)))))))) (do-repeat 0))) -;; Collection: split by + (define hs-repeat-forever (fn @@ -762,13 +842,18 @@ (fn () (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil)))) - (cond - ((= signal "hs-break") nil) - ((= signal "hs-continue") (do-forever)) - (true (do-forever)))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (do-forever)) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (do-forever)) + (true (raise ex))))))) (do-forever))) -;; Collection: joined by + (define hs-repeat-while (fn @@ -776,23 +861,33 @@ (when (cond-fn) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise 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))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (hs-repeat-while cond-fn thunk)) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (hs-repeat-while cond-fn thunk)) + (true (raise ex)))))))) (define hs-repeat-until (fn (cond-fn thunk) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise 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))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (thunk) nil)) + (cond + ((not raised) (if (cond-fn) nil (hs-repeat-until cond-fn thunk))) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") + (if (cond-fn) nil (hs-repeat-until cond-fn thunk))) + (true (raise ex))))))) (define hs-for-each @@ -807,11 +902,16 @@ (when (not (empty? remaining)) (let - ((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (fn-body (first remaining)) nil)))) - (cond - ((= signal "hs-break") nil) - ((= signal "hs-continue") (do-loop (rest remaining))) - (true (do-loop (rest remaining)))))))) + ((ex nil) (raised false)) + (do + (guard + (e (true (do (set! ex e) (set! raised true) nil))) + (do (fn-body (first remaining)) nil)) + (cond + ((not raised) (do-loop (rest remaining))) + ((= (str ex) "hs-break") nil) + ((= (str ex) "hs-continue") (do-loop (rest remaining))) + (true (raise ex)))))))) (do-loop items)))) (begin @@ -829,8 +929,13 @@ (append target (list value)))) ((hs-element? target) (do - (dom-insert-adjacent-html target "beforeend" - (if (hs-element? value) (host-get value "outerHTML") (str value))) + (dom-insert-adjacent-html + target + "beforeend" + (if + (hs-element? value) + (host-get value "outerHTML") + (str value))) target)) (true (str target value))))) (define @@ -840,8 +945,13 @@ (cond ((nil? target) nil) ((hs-element? target) - (dom-insert-adjacent-html target "beforeend" - (if (hs-element? value) (host-get value "outerHTML") (str value)))) + (dom-insert-adjacent-html + target + "beforeend" + (if + (hs-element? value) + (host-get value "outerHTML") + (str value)))) (true nil))))) (define @@ -911,24 +1021,23 @@ (fn (url format no-throw) (let - ((fmt (cond - ((nil? format) "text") - ((or (= format "json") (= format "JSON") (= format "Object")) "json") - ((or (= format "html") (= format "HTML")) "html") - ((or (= format "response") (= format "Response")) "response") - ((or (= format "text") (= format "Text")) "text") - ((or (= format "number") (= format "Number")) "number") - (true "text")))) + ((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") ((or (= format "number") (= format "Number")) "number") (true "text")))) (let ((_hs-before-caller (host-get meta "owner"))) - (when _hs-before-caller + (when + _hs-before-caller (dom-dispatch _hs-before-caller "hyperscript:beforeFetch" {:url url}))) (let ((raw (perform (list "io-fetch" url fmt)))) (begin - (when (= (host-get raw "_network-error") true) + (when + (= (host-get raw "_network-error") true) (raise (or (host-get raw "message") "Network error"))) - (when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false)) + (when + (and + (not no-throw) + (not (= fmt "response")) + (= (host-get raw "ok") false)) (raise (str "HTTP Error: " (host-get raw "status")))) (cond ((= fmt "response") raw) @@ -938,13 +1047,9 @@ (hs-to-number (perform (list "io-parse-text" raw)))) (true (perform (list "io-parse-text" raw))))))))) -(define - hs-fetch - (fn (url format) (hs-fetch-impl url format false))) +(define hs-fetch (fn (url format) (hs-fetch-impl url format false))) -(define - hs-fetch-no-throw - (fn (url format) (hs-fetch-impl url format true))) +(define hs-fetch-no-throw (fn (url format) (hs-fetch-impl url format true))) (define hs-json-escape @@ -1035,7 +1140,8 @@ (true (str value)))) ((= type-name "JSON") (cond - ((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value)))) + ((string? value) + (guard (_e (true value)) (hs-host-to-sx (json-parse value)))) ((not (nil? (host-get value "_json"))) (hs-host-to-sx (perform (list "io-parse-json" value)))) ((dict? value) value) @@ -1206,7 +1312,9 @@ raw-val (if (and (not (nil? opts)) (>= idx 0)) - (host-get (if (list? opts) (nth opts idx) (host-get opts idx)) "value") + (host-get + (if (list? opts) (nth opts idx) (host-get opts idx)) + "value") ""))))) ((or (= typ "checkbox") (= typ "radio")) (if (host-get node "checked") (host-get node "value") nil)) @@ -1418,12 +1526,16 @@ (define hs-measure - (fn (target) (perform (list (quote io-measure) target)))) + (fn + (target) + (hs-null-raise! target) + (when (not (nil? target)) (perform (list (quote io-measure) target))))) (define hs-transition (fn (target prop value duration) + (hs-null-raise! target) (let ((init-attr (str "data-hs-init-" prop))) (when @@ -2010,6 +2122,7 @@ hs-hide! (fn (target strategy) + (hs-empty-raise! target) (if (list? target) (do (for-each (fn (el) (hs-hide-one! el strategy)) target) target) @@ -2051,6 +2164,7 @@ hs-show! (fn (target strategy) + (hs-empty-raise! target) (if (list? target) (do (for-each (fn (el) (hs-show-one! el strategy)) target) target) @@ -2192,9 +2306,7 @@ ((d {})) (do (for-each - (fn - (pair) - (dict-set! d (first pair) (nth pair 1))) + (fn (pair) (dict-set! d (first pair) (nth pair 1))) pairs) d)))) @@ -2560,6 +2672,8 @@ ((= (dom-get-attr el "dom-scope") "isolated") nil) (true (hs-dom-find-owner (dom-parent el) name))))) +;; ── SourceInfo API ──────────────────────────────────────────────── + (define hs-dom-get (fn (el name) (hs-dom-walk (hs-dom-resolve-start el) name))) @@ -2596,8 +2710,6 @@ ((nth entry 2) val))) _hs-dom-watchers))) -;; ── SourceInfo API ──────────────────────────────────────────────── - (define hs-dom-is-ancestor? (fn @@ -2611,7 +2723,15 @@ hs-win-call (fn (fn-name args) - (let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil)))) + (let + ((fn (host-get (host-global "window") fn-name))) + (if + fn + (host-call-fn fn args) + (let + ((msg (str "'" fn-name "' is null"))) + (host-set! (host-global "window") "_hs_null_error" msg) + (guard (_null-e (true nil)) (raise msg))))))) (define hs-source-for @@ -2725,22 +2845,38 @@ {:value value :type "COLON" :op true} (= type "op") (cond - (= value "+") {:value value :type "PLUS" :op true} - (= value "-") {:value value :type "MINUS" :op true} - (= value "*") {:value value :type "MULTIPLY" :op true} - (= value "/") {:value value :type "SLASH" :op true} - (= value "!") {:value value :type "EXCLAMATION" :op true} - (= value "?") {:value value :type "QUESTION" :op true} - (= value "#") {:value value :type "POUND" :op true} - (= value "&") {:value value :type "AMPERSAND" :op true} - (= value "=") {:value value :type "EQUALS" :op true} - (= value "<") {:value value :type "L_ANG" :op true} - (= value ">") {:value value :type "R_ANG" :op true} - (= value "<=") {:value value :type "LTE_ANG" :op true} - (= value ">=") {:value value :type "GTE_ANG" :op true} - (= value "==") {:value value :type "EQ" :op true} - (= value "===") {:value value :type "EQQ" :op true} - (= value "..") {:value value :type "PERIOD_PERIOD" :op true} + (= value "+") + {:value value :type "PLUS" :op true} + (= value "-") + {:value value :type "MINUS" :op true} + (= value "*") + {:value value :type "MULTIPLY" :op true} + (= value "/") + {:value value :type "SLASH" :op true} + (= value "!") + {:value value :type "EXCLAMATION" :op true} + (= value "?") + {:value value :type "QUESTION" :op true} + (= value "#") + {:value value :type "POUND" :op true} + (= value "&") + {:value value :type "AMPERSAND" :op true} + (= value "=") + {:value value :type "EQUALS" :op true} + (= value "<") + {:value value :type "L_ANG" :op true} + (= value ">") + {:value value :type "R_ANG" :op true} + (= value "<=") + {:value value :type "LTE_ANG" :op true} + (= value ">=") + {:value value :type "GTE_ANG" :op true} + (= value "==") + {:value value :type "EQ" :op true} + (= value "===") + {:value value :type "EQQ" :op true} + (= value "..") + {:value value :type "PERIOD_PERIOD" :op true} :else {:value value :type value :op true}) :else {:value (or value "") :type (str type) :op false})))) @@ -2761,8 +2897,7 @@ (fn (s i) (let - ((lst (dict-get s :list)) - (n (len (dict-get s :list)))) + ((lst (dict-get s :list)) (n (len (dict-get s :list)))) (define find (fn @@ -2775,10 +2910,7 @@ (if (= (dict-get tok :type) "whitespace") (find (+ pos 1) count) - (if - (= count 0) - tok - (find (+ pos 1) (- count 1)))))))) + (if (= count 0) tok (find (+ pos 1) (- count 1)))))))) (find (dict-get s :pos) i)))) (define @@ -2786,8 +2918,7 @@ (fn (s) (let - ((lst (dict-get s :list)) - (n (len (dict-get s :list)))) + ((lst (dict-get s :list)) (n (len (dict-get s :list)))) (define find-pos (fn diff --git a/tests/hs-run-filtered.js b/tests/hs-run-filtered.js index 6db62ad0..ca57e2ea 100755 --- a/tests/hs-run-filtered.js +++ b/tests/hs-run-filtered.js @@ -787,6 +787,14 @@ for(let i=startTest;i