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

sx: format_number helper — defuse int_of_float overflow on huge floats

Browse Source 
Shared formatter in sx_types.ml. Small integer-valued floats still print
as plain ints; floats outside safe-int range (|n| >= 1e16) now print as
%.17g (full precision) instead of silently wrapping to negative or 0.
Non-integer values keep %g 6-digit behavior — no existing SX tests regress.

Unblocks Number.MAX_VALUE / Math.pow(2,N) style tests in js-on-sx where
iterative float loops were collapsing to 0 at ~2^63.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-24 15:09:11 +00:00
parent 8f202e03c2
commit b45a69b7a4
9 changed files with 400 additions and 127 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
hosts/ocaml/bin/sx_server.ml
View File

@@ -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

4
hosts/ocaml/lib/sx_primitives.ml
View File

@@ -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 -> ""

4
hosts/ocaml/lib/sx_runtime.ml
View File

@@ -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 -> ""

18
hosts/ocaml/lib/sx_types.ml
View File

@@ -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 -> "" | _ -> "<value>"
@@ -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 '"';

112
lib/hyperscript/parser.sx
View File

@@ -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

128
lib/hyperscript/runtime.sx
View File

@@ -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

112
shared/static/wasm/sx/hs-parser.sx
View File

@@ -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

128
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -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

5
tests/playwright/generate-sx-tests.py
View File

@@ -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