diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index be82ee26..a14d9e25 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -165,9 +165,7 @@ let rec serialize_value = function | Nil -> "nil" | Bool true -> "true" | Bool false -> "false" - | Number n -> - if Float.is_integer n then string_of_int (int_of_float n) - else Printf.sprintf "%g" n + | Number n -> Sx_types.format_number n | String s -> "\"" ^ escape_sx_string s ^ "\"" | Symbol s -> s | Keyword k -> ":" ^ k @@ -214,9 +212,7 @@ let rec serialize_value_hashed (index : (string, string) Hashtbl.t) = function | Nil -> "nil" | Bool true -> "true" | Bool false -> "false" - | Number n -> - if Float.is_integer n then string_of_int (int_of_float n) - else Printf.sprintf "%g" n + | Number n -> Sx_types.format_number n | String s -> "\"" ^ escape_sx_string s ^ "\"" | Symbol s when String.length s > 0 && s.[0] = '~' -> (match Hashtbl.find_opt index s with @@ -1318,7 +1314,7 @@ let rec dispatch env cmd = let rec raw_serialize = function | Nil -> "nil" | Bool true -> "true" | Bool false -> "false" - | Number n -> if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n + | Number n -> Sx_types.format_number n | String s -> "\"" ^ escape_sx_string s ^ "\"" | Symbol s -> s | Keyword k -> ":" ^ k | List items | ListRef { contents = items } -> "(" ^ String.concat " " (List.map raw_serialize items) ^ ")" @@ -1364,9 +1360,7 @@ let rec dispatch env cmd = | Nil -> "nil" | Bool true -> "true" | Bool false -> "false" - | Number n -> - if Float.is_integer n then string_of_int (int_of_float n) - else Printf.sprintf "%g" n + | Number n -> Sx_types.format_number n | String s -> "\"" ^ escape_sx_string s ^ "\"" | Symbol s -> s | Keyword k -> ":" ^ k @@ -3192,7 +3186,7 @@ let pp_atom = Sx_types.inspect let rec est_width = function | Nil -> 3 | Bool true -> 4 | Bool false -> 5 - | Number n -> String.length (if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n) + | Number n -> String.length (Sx_types.format_number n) | String s -> String.length s + 2 | Symbol s -> String.length s | Keyword k -> String.length k + 1 diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 05cd522a..c9b870a3 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -79,9 +79,7 @@ let as_bool = function let rec to_string = function | String s -> s - | Number n -> - if Float.is_integer n then string_of_int (int_of_float n) - else Printf.sprintf "%g" n + | Number n -> Sx_types.format_number n | Bool true -> "true" | Bool false -> "false" | Nil -> "" diff --git a/hosts/ocaml/lib/sx_runtime.ml b/hosts/ocaml/lib/sx_runtime.ml index e702516a..bb36af60 100644 --- a/hosts/ocaml/lib/sx_runtime.ml +++ b/hosts/ocaml/lib/sx_runtime.ml @@ -15,9 +15,7 @@ let prim_call name args = (** Convert any SX value to an OCaml string (internal). *) let value_to_str = function | String s -> s - | Number n -> - if Float.is_integer n then string_of_int (int_of_float n) - else Printf.sprintf "%g" n + | Number n -> Sx_types.format_number n | Bool true -> "true" | Bool false -> "false" | Nil -> "" diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index 956fd6ad..fe7ee53f 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -378,9 +378,21 @@ let env_merge base overlay = (** {1 Value extraction helpers} *) +(** Format a float safely — defuse [int_of_float] overflow on huge + integer-valued floats, keep [%g] for fractions (unchanged). *) +let format_number n = + if Float.is_nan n then "nan" + else if n = Float.infinity then "inf" + else if n = Float.neg_infinity then "-inf" + else if Float.is_integer n && Float.abs n < 1e16 then + string_of_int (int_of_float n) + else if Float.is_integer n then + Printf.sprintf "%.17g" n + else Printf.sprintf "%g" n + let value_to_string = function | String s -> s | Symbol s -> s | Keyword k -> k - | Number n -> if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n + | Number n -> format_number n | Bool true -> "true" | Bool false -> "false" | Nil -> "" | _ -> "" @@ -765,9 +777,7 @@ let rec inspect = function | Nil -> "nil" | Bool true -> "true" | Bool false -> "false" - | Number n -> - if Float.is_integer n then Printf.sprintf "%d" (int_of_float n) - else Printf.sprintf "%g" n + | Number n -> format_number n | String s -> let buf = Buffer.create (String.length s + 2) in Buffer.add_char buf '"'; diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index d52dca2d..6dfdaa60 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -1889,18 +1889,18 @@ (do (adv!) (let - ((start-expr (parse-atom))) + ((start-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) (do (expect-kw! "to") (let - ((end-expr (parse-atom))) + ((end-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) (do (if (not (or (match-kw "of") (match-kw "from"))) (error (str "Expected 'of' or 'from' at position " p))) (let - ((coll (parse-expr))) + ((coll (parse-atom))) (list (quote pick-items) coll start-expr end-expr)))))))) ((and (= typ "keyword") (= val "match")) (do @@ -1908,52 +1908,86 @@ (expect-kw! "of") (let ((regex (parse-atom))) - (do - (cond - ((match-kw "of") nil) - ((match-kw "from") nil) - (true - (error - (str - "Expected of/from after pick match regex at " - p)))) - (let - ((haystack (parse-expr))) - (list (quote pick-match) regex haystack)))))) + (let + ((flags (if (and (= (tp-type) "op") (= (tp-val) "|")) (do (adv!) (let ((fval (tp-val))) (do (adv!) fval))) nil))) + (do + (cond + ((match-kw "of") nil) + ((match-kw "from") nil) + (true + (error + (str + "Expected of/from after pick match regex at " + p)))) + (let + ((haystack (parse-atom))) + (list + (quote pick-match) + (if + (nil? flags) + regex + (list (quote list) regex flags)) + haystack))))))) ((and (= typ "keyword") (= val "matches")) (do (adv!) (expect-kw! "of") (let ((regex (parse-atom))) - (do - (cond - ((match-kw "of") nil) - ((match-kw "from") nil) - (true - (error - (str - "Expected of/from after pick matches regex at " - p)))) - (let - ((haystack (parse-expr))) - (list (quote pick-matches) regex haystack)))))) + (let + ((flags (if (and (= (tp-type) "op") (= (tp-val) "|")) (do (adv!) (let ((fval (tp-val))) (do (adv!) fval))) nil))) + (do + (cond + ((match-kw "of") nil) + ((match-kw "from") nil) + (true + (error + (str + "Expected of/from after pick matches regex at " + p)))) + (let + ((haystack (parse-atom))) + (list + (quote pick-matches) + (if + (nil? flags) + regex + (list (quote list) regex flags)) + haystack))))))) ((and (= typ "ident") (= val "item")) (do (adv!) (let - ((n (parse-expr))) - (do - (if - (not (or (match-kw "of") (match-kw "from"))) - (error (str "Expected 'of' or 'from' at position " p))) - (let - ((coll (parse-expr))) - (list - (quote pick-items) - coll - n - (list (quote +) n 1))))))) + ((start-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) + (cond + ((match-kw "to") + (let + ((end-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) + (do + (if + (not (or (match-kw "of") (match-kw "from"))) + (error + (str "Expected 'of' or 'from' at position " p))) + (let + ((coll (parse-atom))) + (list + (quote pick-items) + coll + start-expr + end-expr))))) + (true + (do + (if + (not (or (match-kw "of") (match-kw "from"))) + (error + (str "Expected 'of' or 'from' at position " p))) + (let + ((coll (parse-atom))) + (list + (quote pick-items) + coll + start-expr + (list (quote +) start-expr 1))))))))) (true (error (str diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 41b98706..bcfce8cb 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -2120,9 +2120,13 @@ (col n) (cond ((nil? col) nil) - ((not (list? col)) col) (true - (let ((m (if (< n (len col)) n (len col)))) (slice col 0 m)))))) + (let + ((m (if (nil? n) 1 n))) + (cond + ((string? col) (slice col 0 m)) + ((list? col) (slice col 0 m)) + (true col))))))) (define hs-pick-last @@ -2130,13 +2134,15 @@ (col n) (cond ((nil? col) nil) - ((not (list? col)) col) (true (let - ((total (len col))) + ((total (cond ((string? col) (len col)) ((list? col) (len col)) (true 0)))) (let - ((start (if (< n total) (- total n) 0))) - (slice col start total))))))) + ((start (max 0 (- total n)))) + (cond + ((string? col) (slice col start total)) + ((list? col) (slice col start total)) + (true col)))))))) (define hs-pick-random @@ -2144,10 +2150,19 @@ (col n) (cond ((nil? col) nil) - ((not (list? col)) col) - ((nil? n) (first col)) (true - (let ((m (if (< n (len col)) n (len col)))) (slice col 0 m)))))) + (let + ((total (cond ((string? col) (len col)) ((list? col) (len col)) (true 0)))) + (cond + ((= total 0) (if (nil? n) nil (list))) + ((nil? n) (nth col 0)) + (true + (let + ((m (max 0 (if (> n total) total n)))) + (cond + ((string? col) (slice col 0 m)) + ((list? col) (slice col 0 m)) + (true col)))))))))) (define hs-pick-items @@ -2155,17 +2170,104 @@ (col start end) (cond ((nil? col) nil) - ((not (list? col)) col) - (true (slice col start end))))) + (true + (let + ((n (cond ((string? col) (len col)) ((list? col) (len col)) (true 0)))) + (let + ((s (cond ((= start "hs-pick-start") 0) ((= start "hs-pick-end") n) ((and (number? start) (< start 0)) (max 0 (+ n start))) (true start))) + (e + (cond + ((= end "hs-pick-end") n) + ((= end "hs-pick-start") 0) + ((and (number? end) (< end 0)) (max 0 (+ n end))) + (true end)))) + (cond + ((string? col) (slice col s e)) + ((list? col) (slice col s e)) + (true col)))))))) (define hs-pick-match (fn (regex haystack) (cond - ((nil? haystack) nil) ((nil? regex) nil) - (true (regex-match regex haystack))))) + ((nil? haystack) nil) + (true (regex-match (hs-pick-regex-pattern regex) haystack))))) + +(begin + (define + hs-pick-regex-ci-char + (fn + (ch) + (let + ((lo (lower ch)) (up (upper ch))) + (if (= lo up) ch (str "[" lo up "]"))))) + (define + hs-pick-regex-ci + (fn + (pat) + (let + ((n (len pat)) (out "")) + (let + ((i 0)) + (let + ((loop (fn () nil))) + (do + (set! + loop + (fn + () + (cond + ((>= i n) nil) + (true + (let + ((ch (char-at pat i))) + (cond + ((= ch "\\") + (do + (set! out (str out ch)) + (set! i (+ i 1)) + (when + (< i n) + (set! out (str out (char-at pat i))) + (set! i (+ i 1))) + (loop))) + (true + (do + (set! out (str out (hs-pick-regex-ci-char ch))) + (set! i (+ i 1)) + (loop))))))))) + (loop) + out)))))) + (define + hs-pick-regex-pattern + (fn + (regex) + (cond + ((nil? regex) "") + ((list? regex) + (let + ((pat (nth regex 0)) (flags (nth regex 1))) + (cond + ((nil? flags) pat) + ((string-contains? flags "i") (hs-pick-regex-ci pat)) + (true pat)))) + (true regex))))) + +(define + hs-pick-matches + (fn + (regex haystack) + (cond + ((nil? regex) nil) + ((nil? haystack) nil) + (true + (let + ((pat (hs-pick-regex-pattern regex))) + (let + ((found (regex-find-all pat haystack))) + (map (fn (m) (list m)) found))))))) (define hs-sorted-by diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index d52dca2d..6dfdaa60 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -1889,18 +1889,18 @@ (do (adv!) (let - ((start-expr (parse-atom))) + ((start-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) (do (expect-kw! "to") (let - ((end-expr (parse-atom))) + ((end-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) (do (if (not (or (match-kw "of") (match-kw "from"))) (error (str "Expected 'of' or 'from' at position " p))) (let - ((coll (parse-expr))) + ((coll (parse-atom))) (list (quote pick-items) coll start-expr end-expr)))))))) ((and (= typ "keyword") (= val "match")) (do @@ -1908,52 +1908,86 @@ (expect-kw! "of") (let ((regex (parse-atom))) - (do - (cond - ((match-kw "of") nil) - ((match-kw "from") nil) - (true - (error - (str - "Expected of/from after pick match regex at " - p)))) - (let - ((haystack (parse-expr))) - (list (quote pick-match) regex haystack)))))) + (let + ((flags (if (and (= (tp-type) "op") (= (tp-val) "|")) (do (adv!) (let ((fval (tp-val))) (do (adv!) fval))) nil))) + (do + (cond + ((match-kw "of") nil) + ((match-kw "from") nil) + (true + (error + (str + "Expected of/from after pick match regex at " + p)))) + (let + ((haystack (parse-atom))) + (list + (quote pick-match) + (if + (nil? flags) + regex + (list (quote list) regex flags)) + haystack))))))) ((and (= typ "keyword") (= val "matches")) (do (adv!) (expect-kw! "of") (let ((regex (parse-atom))) - (do - (cond - ((match-kw "of") nil) - ((match-kw "from") nil) - (true - (error - (str - "Expected of/from after pick matches regex at " - p)))) - (let - ((haystack (parse-expr))) - (list (quote pick-matches) regex haystack)))))) + (let + ((flags (if (and (= (tp-type) "op") (= (tp-val) "|")) (do (adv!) (let ((fval (tp-val))) (do (adv!) fval))) nil))) + (do + (cond + ((match-kw "of") nil) + ((match-kw "from") nil) + (true + (error + (str + "Expected of/from after pick matches regex at " + p)))) + (let + ((haystack (parse-atom))) + (list + (quote pick-matches) + (if + (nil? flags) + regex + (list (quote list) regex flags)) + haystack))))))) ((and (= typ "ident") (= val "item")) (do (adv!) (let - ((n (parse-expr))) - (do - (if - (not (or (match-kw "of") (match-kw "from"))) - (error (str "Expected 'of' or 'from' at position " p))) - (let - ((coll (parse-expr))) - (list - (quote pick-items) - coll - n - (list (quote +) n 1))))))) + ((start-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) + (cond + ((match-kw "to") + (let + ((end-expr (cond ((and (= (tp-type) "keyword") (= (tp-val) "start")) (do (adv!) "hs-pick-start")) ((and (= (tp-type) "keyword") (= (tp-val) "end")) (do (adv!) "hs-pick-end")) (true (parse-atom))))) + (do + (if + (not (or (match-kw "of") (match-kw "from"))) + (error + (str "Expected 'of' or 'from' at position " p))) + (let + ((coll (parse-atom))) + (list + (quote pick-items) + coll + start-expr + end-expr))))) + (true + (do + (if + (not (or (match-kw "of") (match-kw "from"))) + (error + (str "Expected 'of' or 'from' at position " p))) + (let + ((coll (parse-atom))) + (list + (quote pick-items) + coll + start-expr + (list (quote +) start-expr 1))))))))) (true (error (str diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index 41b98706..bcfce8cb 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -2120,9 +2120,13 @@ (col n) (cond ((nil? col) nil) - ((not (list? col)) col) (true - (let ((m (if (< n (len col)) n (len col)))) (slice col 0 m)))))) + (let + ((m (if (nil? n) 1 n))) + (cond + ((string? col) (slice col 0 m)) + ((list? col) (slice col 0 m)) + (true col))))))) (define hs-pick-last @@ -2130,13 +2134,15 @@ (col n) (cond ((nil? col) nil) - ((not (list? col)) col) (true (let - ((total (len col))) + ((total (cond ((string? col) (len col)) ((list? col) (len col)) (true 0)))) (let - ((start (if (< n total) (- total n) 0))) - (slice col start total))))))) + ((start (max 0 (- total n)))) + (cond + ((string? col) (slice col start total)) + ((list? col) (slice col start total)) + (true col)))))))) (define hs-pick-random @@ -2144,10 +2150,19 @@ (col n) (cond ((nil? col) nil) - ((not (list? col)) col) - ((nil? n) (first col)) (true - (let ((m (if (< n (len col)) n (len col)))) (slice col 0 m)))))) + (let + ((total (cond ((string? col) (len col)) ((list? col) (len col)) (true 0)))) + (cond + ((= total 0) (if (nil? n) nil (list))) + ((nil? n) (nth col 0)) + (true + (let + ((m (max 0 (if (> n total) total n)))) + (cond + ((string? col) (slice col 0 m)) + ((list? col) (slice col 0 m)) + (true col)))))))))) (define hs-pick-items @@ -2155,17 +2170,104 @@ (col start end) (cond ((nil? col) nil) - ((not (list? col)) col) - (true (slice col start end))))) + (true + (let + ((n (cond ((string? col) (len col)) ((list? col) (len col)) (true 0)))) + (let + ((s (cond ((= start "hs-pick-start") 0) ((= start "hs-pick-end") n) ((and (number? start) (< start 0)) (max 0 (+ n start))) (true start))) + (e + (cond + ((= end "hs-pick-end") n) + ((= end "hs-pick-start") 0) + ((and (number? end) (< end 0)) (max 0 (+ n end))) + (true end)))) + (cond + ((string? col) (slice col s e)) + ((list? col) (slice col s e)) + (true col)))))))) (define hs-pick-match (fn (regex haystack) (cond - ((nil? haystack) nil) ((nil? regex) nil) - (true (regex-match regex haystack))))) + ((nil? haystack) nil) + (true (regex-match (hs-pick-regex-pattern regex) haystack))))) + +(begin + (define + hs-pick-regex-ci-char + (fn + (ch) + (let + ((lo (lower ch)) (up (upper ch))) + (if (= lo up) ch (str "[" lo up "]"))))) + (define + hs-pick-regex-ci + (fn + (pat) + (let + ((n (len pat)) (out "")) + (let + ((i 0)) + (let + ((loop (fn () nil))) + (do + (set! + loop + (fn + () + (cond + ((>= i n) nil) + (true + (let + ((ch (char-at pat i))) + (cond + ((= ch "\\") + (do + (set! out (str out ch)) + (set! i (+ i 1)) + (when + (< i n) + (set! out (str out (char-at pat i))) + (set! i (+ i 1))) + (loop))) + (true + (do + (set! out (str out (hs-pick-regex-ci-char ch))) + (set! i (+ i 1)) + (loop))))))))) + (loop) + out)))))) + (define + hs-pick-regex-pattern + (fn + (regex) + (cond + ((nil? regex) "") + ((list? regex) + (let + ((pat (nth regex 0)) (flags (nth regex 1))) + (cond + ((nil? flags) pat) + ((string-contains? flags "i") (hs-pick-regex-ci pat)) + (true pat)))) + (true regex))))) + +(define + hs-pick-matches + (fn + (regex haystack) + (cond + ((nil? regex) nil) + ((nil? haystack) nil) + (true + (let + ((pat (hs-pick-regex-pattern regex))) + (let + ((found (regex-find-all pat haystack))) + (map (fn (m) (list m)) found))))))) (define hs-sorted-by diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index fbaa3b71..1ce2f910 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -1774,8 +1774,9 @@ def extract_hs_expr(raw): expr = raw.strip().replace('\n', ' ').replace('\t', ' ') # Collapse multiple spaces expr = re.sub(r'\s+', ' ', expr) - # Escape quotes for SX string - expr = expr.replace('\\', '').replace('"', '\\"') + # Escape backslashes (preserve regex escapes like \d, CSS escapes, lambda \) + # then escape quotes for SX string. + expr = expr.replace('\\', '\\\\').replace('"', '\\"') return expr