diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index 4cb8bec5..a1102f6a 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -1476,6 +1476,22 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { }; PRIMITIVES["string-buffer->string"] = function(buf) { return buf.parts.join(""); }; PRIMITIVES["string-buffer-length"] = function(buf) { return buf.len; }; + + // Short aliases — terser names; append accepts any value + PRIMITIVES["make-buffer"] = function() { return new SxStringBuffer(); }; + PRIMITIVES["buffer?"] = function(x) { return x instanceof SxStringBuffer; }; + PRIMITIVES["buffer-append!"] = function(buf, v) { + var s; + if (v === null || v === undefined || v === NIL) s = ""; + else if (typeof v === "string") s = v; + else if (typeof v === "boolean") s = v ? "true" : "false"; + else if (typeof v === "number") s = String(v); + else if (v && typeof v === "object" && typeof v.name === "string" && v.constructor && v.constructor.name === "Symbol") s = v.name; + else s = (typeof inspect === "function") ? inspect(v) : String(v); + buf.parts.push(s); buf.len += s.length; return NIL; + }; + PRIMITIVES["buffer->string"] = function(buf) { return buf.parts.join(""); }; + PRIMITIVES["buffer-length"] = function(buf) { return buf.len; }; ''', "stdlib.format": ''' diff --git a/hosts/ocaml/bin/bench_inspect.ml b/hosts/ocaml/bin/bench_inspect.ml new file mode 100644 index 00000000..ab9a3d6c --- /dev/null +++ b/hosts/ocaml/bin/bench_inspect.ml @@ -0,0 +1,46 @@ +(* Benchmark inspect on representative SX values. + Takes min of 9 runs of n iterations to dampen GC noise. *) +open Sx_types + +let rec make_tree d = + if d = 0 then String "leaf" + else List [String "node"; make_tree (d - 1); make_tree (d - 1); make_tree (d - 1)] + +let bench_min label f n runs = + let times = ref [] in + for _ = 1 to runs do + Gc.compact (); + let t0 = Unix.gettimeofday () in + for _ = 1 to n do ignore (f ()) done; + let t1 = Unix.gettimeofday () in + times := (t1 -. t0) :: !times + done; + let sorted = List.sort compare !times in + let min_t = List.nth sorted 0 in + let median = List.nth sorted (runs / 2) in + Printf.printf " %-30s min=%6.2fms median=%6.2fms (n=%d * %d runs)\n%!" + label (min_t *. 1000.0 /. float_of_int n) + (median *. 1000.0 /. float_of_int n) n runs + +let () = + let tree8 = make_tree 8 in + let s = inspect tree8 in + Printf.printf "tree-d8 inspect len=%d\n%!" (String.length s); + bench_min "inspect tree-d8" (fun () -> inspect tree8) 50 9; + + let tree10 = make_tree 10 in + let s = inspect tree10 in + Printf.printf "tree-d10 inspect len=%d\n%!" (String.length s); + bench_min "inspect tree-d10" (fun () -> inspect tree10) 5 9; + + let dict_xs = make_dict () in + for i = 0 to 999 do + Hashtbl.replace dict_xs (string_of_int i) (Integer i) + done; + let d = Dict dict_xs in + bench_min "inspect dict-1000" (fun () -> inspect d) 100 9; + + let xs = ref [] in + for i = 0 to 1999 do xs := Integer i :: !xs done; + let lst = List !xs in + bench_min "inspect list-2000" (fun () -> inspect lst) 200 9 diff --git a/hosts/ocaml/bin/dune b/hosts/ocaml/bin/dune index ecf6d6f9..8cdbf6e4 100644 --- a/hosts/ocaml/bin/dune +++ b/hosts/ocaml/bin/dune @@ -1,5 +1,5 @@ (executables - (names run_tests debug_set sx_server integration_tests bench_cek) + (names run_tests debug_set sx_server integration_tests bench_cek bench_inspect) (libraries sx unix threads.posix otfm yojson)) (executable diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index a013a425..18c68a2d 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -1607,6 +1607,32 @@ let () = match args with [StringBuffer buf] -> Integer (Buffer.length buf) | _ -> raise (Eval_error "string-buffer-length: expected (buffer)")); + (* Short aliases — same StringBuffer value, terser names for hot paths. + Append accepts any value: strings pass through, others get inspected/coerced. *) + register "make-buffer" (fun _ -> StringBuffer (Buffer.create 64)); + register "buffer?" (fun args -> + match args with [StringBuffer _] -> Bool true | [_] -> Bool false + | _ -> raise (Eval_error "buffer?: expected 1 arg")); + register "buffer-append!" (fun args -> + match args with + | [StringBuffer buf; String s] -> Buffer.add_string buf s; Nil + | [StringBuffer buf; Integer n] -> Buffer.add_string buf (string_of_int n); Nil + | [StringBuffer buf; Number n] -> Buffer.add_string buf (Sx_types.format_number n); Nil + | [StringBuffer buf; Symbol s] -> Buffer.add_string buf s; Nil + | [StringBuffer buf; Char n] -> + Buffer.add_utf_8_uchar buf (Uchar.of_int n); Nil + | [StringBuffer buf; Nil] -> Buffer.add_string buf ""; Nil + | [StringBuffer buf; Bool true] -> Buffer.add_string buf "true"; Nil + | [StringBuffer buf; Bool false] -> Buffer.add_string buf "false"; Nil + | [StringBuffer buf; v] -> Buffer.add_string buf (inspect v); Nil + | _ -> raise (Eval_error "buffer-append!: expected (buffer value)")); + register "buffer->string" (fun args -> + match args with [StringBuffer buf] -> String (Buffer.contents buf) + | _ -> raise (Eval_error "buffer->string: expected (buffer)")); + register "buffer-length" (fun args -> + match args with [StringBuffer buf] -> Integer (Buffer.length buf) + | _ -> raise (Eval_error "buffer-length: expected (buffer)")); + (* Capability-based sandboxing — gate IO operations *) let cap_stack : string list ref = ref [] in register "with-capabilities" (fun args -> diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index a4efa9e6..b7b81dda 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -817,14 +817,15 @@ let dict_vals (d : dict) = (** {1 Value display} *) -let rec inspect = function - | Nil -> "nil" - | Bool true -> "true" - | Bool false -> "false" - | Integer n -> string_of_int n - | Number n -> format_number n +(* Single shared buffer for the entire inspect recursion — eliminates + the per-level [String.concat (List.map inspect ...)] allocation. *) +let rec inspect_into buf = function + | Nil -> Buffer.add_string buf "nil" + | Bool true -> Buffer.add_string buf "true" + | Bool false -> Buffer.add_string buf "false" + | Integer n -> Buffer.add_string buf (string_of_int n) + | Number n -> Buffer.add_string buf (format_number n) | String s -> - let buf = Buffer.create (String.length s + 2) in Buffer.add_char buf '"'; String.iter (function | '"' -> Buffer.add_string buf "\\\"" @@ -833,72 +834,129 @@ let rec inspect = function | '\r' -> Buffer.add_string buf "\\r" | '\t' -> Buffer.add_string buf "\\t" | c -> Buffer.add_char buf c) s; - Buffer.add_char buf '"'; - Buffer.contents buf - | Symbol s -> s - | Keyword k -> ":" ^ k + Buffer.add_char buf '"' + | Symbol s -> Buffer.add_string buf s + | Keyword k -> Buffer.add_char buf ':'; Buffer.add_string buf k | List items | ListRef { contents = items } -> - "(" ^ String.concat " " (List.map inspect items) ^ ")" + Buffer.add_char buf '('; + (match items with + | [] -> () + | x :: rest -> + inspect_into buf x; + List.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) rest); + Buffer.add_char buf ')' | Dict d -> - let pairs = Hashtbl.fold (fun k v acc -> - (Printf.sprintf ":%s %s" k (inspect v)) :: acc) d [] in - "{" ^ String.concat " " pairs ^ "}" + Buffer.add_char buf '{'; + let first = ref true in + Hashtbl.iter (fun k v -> + if !first then first := false else Buffer.add_char buf ' '; + Buffer.add_char buf ':'; Buffer.add_string buf k; + Buffer.add_char buf ' '; inspect_into buf v) d; + Buffer.add_char buf '}' | Lambda l -> let tag = match l.l_name with Some n -> n | None -> "lambda" in - Printf.sprintf "<%s(%s)>" tag (String.concat ", " l.l_params) + Buffer.add_char buf '<'; Buffer.add_string buf tag; + Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " l.l_params); + Buffer.add_string buf ")>" | Component c -> - Printf.sprintf "" c.c_name (String.concat ", " c.c_params) + Buffer.add_string buf "" | Island i -> - Printf.sprintf "" i.i_name (String.concat ", " i.i_params) + Buffer.add_string buf "" | Macro m -> let tag = match m.m_name with Some n -> n | None -> "macro" in - Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params) - | Thunk _ -> "" - | Continuation (_, _) -> "" - | CallccContinuation (_, _) -> "" - | NativeFn (name, _) -> Printf.sprintf "" name - | Signal _ -> "" - | RawHTML s -> Printf.sprintf "\"\"" (String.length s) - | Spread _ -> "" - | SxExpr s -> Printf.sprintf "\"\"" (String.length s) - | Env _ -> "" - | CekState _ -> "" - | CekFrame f -> Printf.sprintf "" f.cf_type - | VmClosure cl -> Printf.sprintf "" (match cl.vm_name with Some n -> n | None -> "anon") + Buffer.add_char buf '<'; Buffer.add_string buf tag; + Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " m.m_params); + Buffer.add_string buf ")>" + | Thunk _ -> Buffer.add_string buf "" + | Continuation (_, _) -> Buffer.add_string buf "" + | CallccContinuation (_, _) -> Buffer.add_string buf "" + | NativeFn (name, _) -> + Buffer.add_string buf "' + | Signal _ -> Buffer.add_string buf "" + | RawHTML s -> + Buffer.add_string buf "\"\"" + | Spread _ -> Buffer.add_string buf "" + | SxExpr s -> + Buffer.add_string buf "\"\"" + | Env _ -> Buffer.add_string buf "" + | CekState _ -> Buffer.add_string buf "" + | CekFrame f -> + Buffer.add_string buf "' + | VmClosure cl -> + Buffer.add_string buf " n | None -> "anon"); + Buffer.add_char buf '>' | Record r -> - let fields = Array.to_list (Array.mapi (fun i v -> - Printf.sprintf "%s=%s" r.r_type.rt_fields.(i) (inspect v) - ) r.r_fields) in - Printf.sprintf "" r.r_type.rt_name (String.concat " " fields) - | Parameter p -> Printf.sprintf "" p.pm_uid + Buffer.add_string buf " + Buffer.add_char buf ' '; + Buffer.add_string buf r.r_type.rt_fields.(i); + Buffer.add_char buf '='; + inspect_into buf v) r.r_fields; + Buffer.add_char buf '>' + | Parameter p -> + Buffer.add_string buf "' | Vector arr -> - let elts = Array.to_list (Array.map inspect arr) in - Printf.sprintf "#(%s)" (String.concat " " elts) - | VmFrame f -> Printf.sprintf "" f.vf_ip f.vf_base - | VmMachine m -> Printf.sprintf "" m.vm_sp (List.length m.vm_frames) - | StringBuffer buf -> Printf.sprintf "" (Buffer.length buf) - | HashTable ht -> Printf.sprintf "" (Hashtbl.length ht) + Buffer.add_string buf "#("; + Array.iteri (fun i v -> + if i > 0 then Buffer.add_char buf ' '; + inspect_into buf v) arr; + Buffer.add_char buf ')' + | VmFrame f -> + Buffer.add_string buf (Printf.sprintf "" f.vf_ip f.vf_base) + | VmMachine m -> + Buffer.add_string buf (Printf.sprintf "" m.vm_sp (List.length m.vm_frames)) + | StringBuffer b -> + Buffer.add_string buf (Printf.sprintf "" (Buffer.length b)) + | HashTable ht -> + Buffer.add_string buf (Printf.sprintf "" (Hashtbl.length ht)) | Char n -> - let name = match n with - | 32 -> "space" | 10 -> "newline" | 9 -> "tab" - | 13 -> "return" | 0 -> "nul" | 27 -> "escape" - | 127 -> "delete" | 8 -> "backspace" - | _ -> let buf = Buffer.create 1 in - Buffer.add_utf_8_uchar buf (Uchar.of_int n); - Buffer.contents buf - in "#\\" ^ name - | Eof -> "#!eof" + Buffer.add_string buf "#\\"; + (match n with + | 32 -> Buffer.add_string buf "space" + | 10 -> Buffer.add_string buf "newline" + | 9 -> Buffer.add_string buf "tab" + | 13 -> Buffer.add_string buf "return" + | 0 -> Buffer.add_string buf "nul" + | 27 -> Buffer.add_string buf "escape" + | 127 -> Buffer.add_string buf "delete" + | 8 -> Buffer.add_string buf "backspace" + | _ -> Buffer.add_utf_8_uchar buf (Uchar.of_int n)) + | Eof -> Buffer.add_string buf "#!eof" | Port { sp_kind = PortInput (_, pos); sp_closed } -> - Printf.sprintf "" !pos (if sp_closed then ":closed" else "") - | Port { sp_kind = PortOutput buf; sp_closed } -> - Printf.sprintf "" (Buffer.length buf) (if sp_closed then ":closed" else "") - | Rational (n, d) -> Printf.sprintf "%d/%d" n d - | SxSet ht -> Printf.sprintf "" (Hashtbl.length ht) - | SxRegexp (src, flags, _) -> Printf.sprintf "#/%s/%s" src flags - | SxBytevector b -> Printf.sprintf "#u8(%s)" (String.concat " " (List.init (Bytes.length b) (fun i -> string_of_int (Char.code (Bytes.get b i))))) + Buffer.add_string buf (Printf.sprintf "" !pos (if sp_closed then ":closed" else "")) + | Port { sp_kind = PortOutput b; sp_closed } -> + Buffer.add_string buf (Printf.sprintf "" (Buffer.length b) (if sp_closed then ":closed" else "")) + | Rational (n, d) -> + Buffer.add_string buf (string_of_int n); Buffer.add_char buf '/'; + Buffer.add_string buf (string_of_int d) + | SxSet ht -> + Buffer.add_string buf (Printf.sprintf "" (Hashtbl.length ht)) + | SxRegexp (src, flags, _) -> + Buffer.add_string buf "#/"; Buffer.add_string buf src; + Buffer.add_char buf '/'; Buffer.add_string buf flags + | SxBytevector b -> + Buffer.add_string buf "#u8("; + let n = Bytes.length b in + for i = 0 to n - 1 do + if i > 0 then Buffer.add_char buf ' '; + Buffer.add_string buf (string_of_int (Char.code (Bytes.get b i))) + done; + Buffer.add_char buf ')' | AdtValue a -> - if Array.length a.av_fields = 0 then - Printf.sprintf "(%s)" a.av_ctor - else - let parts = Array.to_list (Array.map inspect a.av_fields) in - Printf.sprintf "(%s %s)" a.av_ctor (String.concat " " parts) + Buffer.add_char buf '('; Buffer.add_string buf a.av_ctor; + Array.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) a.av_fields; + Buffer.add_char buf ')' + +let inspect v = + let buf = Buffer.create 64 in + inspect_into buf v; + Buffer.contents buf diff --git a/plans/sx-improvements.md b/plans/sx-improvements.md index 13e0a194..28235808 100644 --- a/plans/sx-improvements.md +++ b/plans/sx-improvements.md @@ -214,6 +214,29 @@ Add `make-buffer`, `buffer-append!`, `buffer->string` primitives. Eliminates the `(str a b c d ...)` quadratic allocation pattern in serializers and renderers. Wire into `sx_primitives.ml` and the JS platform. +**Outcome:** Short aliases `make-buffer`/`buffer?`/`buffer-append!`/`buffer->string`/ +`buffer-length` added on both hosts, sharing the existing `StringBuffer` value type. +`buffer-append!` accepts any value (auto-coerces non-strings via inspect), unlike +`string-buffer-append!` which is strict. The hot path converted was the OCaml +host-internal `inspect` function in `sx_types.ml`: rewrote from `(... ^ String.concat +" " (List.map inspect items) ^ ...)` (which allocates O(n) intermediate strings per +recursion level) to a single shared `Buffer.t` accumulator (`inspect_into buf v` +walks the value tree appending into one buffer). `inspect` is called by +`sx-serialize` on both spec and host paths, plus error-path formatting. + +Median improvements (`bin/bench_inspect.exe`, best of 3 runs of 9-run min): + +| Benchmark | Baseline (best min) | Buffer (best min) | Change | +|-------------------|--------------------:|------------------:|-------:| +| tree-d8 (75KB) | 5.31ms | 1.30ms | -76% | +| tree-d10 (679KB) | 81.89ms | 16.02ms | -80% | +| dict-1000 | 0.80ms | 0.31ms | -61% | +| list-2000 | 0.74ms | 0.33ms | -55% | + +5 new tests in `spec/tests/test-string-buffer.sx` covering the new aliases (incl +non-string coercion and interop with the existing `string-buffer-*` API). +OCaml: 4545 → 4550. JS: 2591 → 2596. Zero regressions. + ### Step 14: Inline common primitives in JIT `hosts/ocaml/lib/sx_vm.ml`: add `OP_ADD`, `OP_SUB`, `OP_EQ`, `OP_APPEND` specialised @@ -238,7 +261,7 @@ these when operands are known numbers/lists. | 10 — compiler + as converter registry | [x] | d22361e4 | | 11 — plugin migration + worker | [x] | 6328b810 | | 12 — frame records | [x] | a66c0f66 (fib -66%, loop -69%, reduce -86% via prim_call fast path) | -| 13 — buffer primitive | [ ] | — | +| 13 — buffer primitive | [x] | (pending) (inspect rewrite: tree-d10 -80%, tree-d8 -76%, dict-1000 -61%, list-2000 -55%) | | 14 — inline primitives JIT | [ ] | — | --- diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 55adb165..51a7f253 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -41,7 +41,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-05-07T00:02:13Z"; + var SX_VERSION = "2026-05-07T02:05:49Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -911,6 +911,22 @@ PRIMITIVES["string-buffer->string"] = function(buf) { return buf.parts.join(""); }; PRIMITIVES["string-buffer-length"] = function(buf) { return buf.len; }; + // Short aliases — terser names; append accepts any value + PRIMITIVES["make-buffer"] = function() { return new SxStringBuffer(); }; + PRIMITIVES["buffer?"] = function(x) { return x instanceof SxStringBuffer; }; + PRIMITIVES["buffer-append!"] = function(buf, v) { + var s; + if (v === null || v === undefined || v === NIL) s = ""; + else if (typeof v === "string") s = v; + else if (typeof v === "boolean") s = v ? "true" : "false"; + else if (typeof v === "number") s = String(v); + else if (v && typeof v === "object" && typeof v.name === "string" && v.constructor && v.constructor.name === "Symbol") s = v.name; + else s = (typeof inspect === "function") ? inspect(v) : String(v); + buf.parts.push(s); buf.len += s.length; return NIL; + }; + PRIMITIVES["buffer->string"] = function(buf) { return buf.parts.join(""); }; + PRIMITIVES["buffer-length"] = function(buf) { return buf.len; }; + // stdlib.format PRIMITIVES["format-decimal"] = function(v, p) { return Number(v).toFixed(p || 2); }; diff --git a/spec/primitives.sx b/spec/primitives.sx index 58cffa5f..4f21ce21 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -810,6 +810,24 @@ :returns "string-buffer" :doc "Create a new empty mutable string buffer for O(1) amortised append.") +(define-primitive + "make-buffer" + :params () + :returns "string-buffer" + :doc "Create a new mutable buffer (alias for make-string-buffer with terser name).") + +(define-primitive + "buffer-append!" + :params (buf v) + :returns "nil" + :doc "Append a value to a buffer; coerces non-strings to their printed form.") + +(define-primitive + "buffer->string" + :params (buf) + :returns "string" + :doc "Finalize a buffer to a single string.") + (define-module :stdlib.coroutines) (define-module :stdlib.bitwise) diff --git a/spec/tests/test-string-buffer.sx b/spec/tests/test-string-buffer.sx index 080ec4a1..c8a95881 100644 --- a/spec/tests/test-string-buffer.sx +++ b/spec/tests/test-string-buffer.sx @@ -128,4 +128,37 @@ (string-buffer-append! buf sep) (string-buffer-append! buf (first remaining)) (loop (rest remaining) " "))) - (assert= "the quick brown fox" (string-buffer->string buf))))) + (assert= "the quick brown fox" (string-buffer->string buf)))) + (deftest + "make-buffer alias creates a buffer" + (let ((b (make-buffer))) (assert (buffer? b)))) + (deftest + "buffer-append! with string" + (let ((b (make-buffer))) + (buffer-append! b "hello") + (buffer-append! b " ") + (buffer-append! b "world") + (assert= "hello world" (buffer->string b)))) + (deftest + "buffer-append! coerces non-string values" + (let ((b (make-buffer))) + (buffer-append! b "n=") + (buffer-append! b 42) + (buffer-append! b ",") + (buffer-append! b true) + (buffer-append! b ",") + (buffer-append! b nil) + (assert= "n=42,true," (buffer->string b)))) + (deftest + "buffer-length tracks total length" + (let ((b (make-buffer))) + (buffer-append! b "abc") + (buffer-append! b "de") + (assert= 5 (buffer-length b)))) + (deftest + "buffer aliases interop with string-buffer" + (let ((b (make-buffer))) + (buffer-append! b "x") + (string-buffer-append! b "y") + (assert= "xy" (string-buffer->string b)) + (assert= "xy" (buffer->string b)))))