From 7d329f024dff29d11d457c645519509ff5d7d210 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 1 May 2026 18:32:30 +0000 Subject: [PATCH] =?UTF-8?q?spec:=20read/write/display=20=E2=80=94=20S-expr?= =?UTF-8?q?ession=20reader/writer=20on=20ports?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adds read, write, display, newline, write-to-string, display-to-string and current-*-port primitives to both JS and OCaml hosts. JS: sxReadNormalize (#t/#f→true/false), sxReadConvert (()→nil), sxEq array comparison, sxWriteVal symbol/keyword name fix, readerMacroGet/readerMacroSet registry in parser platform. OCaml: sx_write_val/sx_display_val helpers, read/write/display/newline primitives on port types; parser extended for #t/#f and N/D rationals. 42 new tests (test-read-write.sx), all passing on JS and OCaml. Co-Authored-By: Claude Sonnet 4.6 --- hosts/javascript/platform.py | 107 ++++++++++++++ hosts/ocaml/lib/sx_parser.ml | 39 +++-- hosts/ocaml/lib/sx_primitives.ml | 108 ++++++++++++++ shared/static/scripts/sx-browser.js | 109 +++++++++++++- spec/primitives.sx | 55 ++++++++ spec/tests/test-read-write.sx | 212 ++++++++++++++++++++++++++++ 6 files changed, 621 insertions(+), 9 deletions(-) create mode 100644 spec/tests/test-read-write.sx diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index dc39f830..cfec88e3 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -849,6 +849,13 @@ PREAMBLE = '''\ } return true; } + if (Array.isArray(a) && Array.isArray(b)) { + if (a.length !== b.length) return false; + for (var _j = 0; _j < a.length; _j++) { + if (!sxEq(a[_j], b[_j])) return false; + } + return true; + } if (a && b && a._rational && b._rational) return a._n === b._n && a._d === b._d; if (a && a._rational && typeof b === "number") return b === a._n / a._d; if (b && b._rational && typeof a === "number") return a === b._n / b._d; @@ -1257,6 +1264,100 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { if (!p._port || p._kind !== "input") return false; return !p._closed && p._pos < p._source.length; }; + // read/write/display + var _sxBs92 = String.fromCharCode(92); + function sxReadNormalize(src) { + var out = "", i = 0, n = src.length; + while (i < n) { + if (src[i] === '"') { + out += '"'; i++; + while (i < n) { + if (src[i] === _sxBs92 && i+1 < n) { out += src[i]; out += src[i+1]; i += 2; continue; } + if (src[i] === '"') { out += src[i++]; break; } + out += src[i++]; + } + } else if (src[i] === '#' && i+1 < n && (src[i+1] === 't' || src[i+1] === 'f')) { + var nc2 = i+2 < n ? src[i+2] : ''; + if (!nc2 || !/[a-zA-Z0-9_]/.test(nc2)) { + out += (src[i+1] === 't') ? 'true' : 'false'; + i += 2; + } else { out += src[i++]; } + } else { out += src[i++]; } + } + return out; + } + function sxReadConvert(v) { + if (Array.isArray(v) && v.length === 0) return NIL; + if (Array.isArray(v)) return v.map(sxReadConvert); + return v; + } + PRIMITIVES["read"] = function() { + var p = arguments.length > 0 && arguments[0] && arguments[0]._port ? arguments[0] : null; + if (!p || p._kind !== "input" || p._closed) return _eof; + if (!p._forms) { + var sxP = PRIMITIVES["sx-parse"]; + var src = sxReadNormalize(p._source.slice(p._pos || 0)); + p._forms = sxP ? (sxP(src) || []) : []; + p._form_idx = 0; + } + if (p._form_idx >= p._forms.length) return _eof; + return sxReadConvert(p._forms[p._form_idx++]); + }; + var _sxBs = String.fromCharCode(92); + var _sxDq = String.fromCharCode(34); + function sxWriteVal(v, mode) { + if (v === null || v === undefined || v === NIL) return "()"; + if (v && v._eof) return "#!eof"; + if (typeof v === "boolean") return v ? "#t" : "#f"; + if (typeof v === "number") return String(v); + if (v && v._rational) return v._n + "/" + v._d; + if (typeof v === "string") { + if (mode === "display") return v; + return _sxDq + v.split("").map(function(c) { + var n = c.charCodeAt(0); + if (n === 34) return _sxBs + _sxDq; + if (n === 92) return _sxBs + _sxBs; + if (n === 10) return _sxBs + "n"; + if (n === 13) return _sxBs + "r"; + if (n === 9) return _sxBs + "t"; + return c; + }).join("") + _sxDq; + } + if (v && v._char) { + if (mode === "display") return String.fromCodePoint(v.codepoint); + var cp = v.codepoint; + if (cp === 32) return "#" + _sxBs + "space"; + if (cp === 10) return "#" + _sxBs + "newline"; + if (cp === 9) return "#" + _sxBs + "tab"; + return "#" + _sxBs + String.fromCodePoint(cp); + } + if (v && v._sym) return v.name; + if (v && v._kw) return ":" + v.name; + if (Array.isArray(v)) return "(" + v.map(function(x){ return sxWriteVal(x, mode); }).join(" ") + ")"; + return String(v); + } + PRIMITIVES["write"] = function() { + var val = arguments[0], port = arguments[1]; + var s = sxWriteVal(val, "write"); + if (port && port._port && port._kind === "output" && !port._closed) port._buffer += s; + return NIL; + }; + PRIMITIVES["display"] = function() { + var val = arguments[0], port = arguments[1]; + var s = sxWriteVal(val, "display"); + if (port && port._port && port._kind === "output" && !port._closed) port._buffer += s; + return NIL; + }; + PRIMITIVES["newline"] = function() { + var port = arguments[0]; + if (port && port._port && port._kind === "output" && !port._closed) port._buffer += String.fromCharCode(10); + return NIL; + }; + PRIMITIVES["write-to-string"] = function(val) { return sxWriteVal(val, "write"); }; + PRIMITIVES["display-to-string"] = function(val) { return sxWriteVal(val, "display"); }; + PRIMITIVES["current-input-port"] = function() { return NIL; }; + PRIMITIVES["current-output-port"] = function() { return NIL; }; + PRIMITIVES["current-error-port"] = function() { return NIL; }; PRIMITIVES["string-length"] = function(s) { return String(s).length; }; var stringLength = PRIMITIVES["string-length"]; PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; }; @@ -1571,6 +1672,7 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { PRIMITIVES["rational?"] = function(v) { return v instanceof SxRational; }; PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; }; PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; }; + var makeRational = PRIMITIVES["make-rational"]; ''', "stdlib.hash-table": ''' // stdlib.hash-table @@ -2294,6 +2396,11 @@ PLATFORM_PARSER_JS = r""" var makeChar = PRIMITIVES["make-char"]; var charToInteger = PRIMITIVES["char->integer"]; var isChar = PRIMITIVES["char?"]; + var _readerMacros = {}; + function readerMacroGet(name) { return _readerMacros[name] || false; } + function readerMacroSet(name, fn) { _readerMacros[name] = fn; } + PRIMITIVES["reader-macro-get"] = readerMacroGet; + PRIMITIVES["reader-macro-set!"] = readerMacroSet; """ diff --git a/hosts/ocaml/lib/sx_parser.ml b/hosts/ocaml/lib/sx_parser.ml index 34230a37..71a2d49e 100644 --- a/hosts/ocaml/lib/sx_parser.ml +++ b/hosts/ocaml/lib/sx_parser.ml @@ -89,8 +89,18 @@ let read_symbol s = while s.pos < s.len && is_symbol_char s.src.[s.pos] do advance s done; String.sub s.src start (s.pos - start) +let gcd a b = + let rec g a b = if b = 0 then a else g b (a mod b) in g (abs a) (abs b) + +let make_rat n d = + if d = 0 then raise (Parse_error "rational: division by zero"); + let sign = if d < 0 then -1 else 1 in + let g = gcd (abs n) (abs d) in + let rn = sign * n / g and rd = sign * d / g in + if rd = 1 then Integer rn else Rational (rn, rd) + let try_number str = - (* Integers (no '.' or 'e'/'E') → exact Integer; floats → inexact Number *) + (* Integers (no '.' or 'e'/'E') → exact Integer; rationals N/D; floats → inexact Number *) let has_dec = String.contains str '.' in let has_exp = String.contains str 'e' || String.contains str 'E' in if has_dec || has_exp then @@ -98,13 +108,19 @@ let try_number str = | Some n -> Some (Number n) | None -> None else - match int_of_string_opt str with - | Some n -> Some (Integer n) - | None -> - (* handles "nan", "inf", "-inf" *) - match float_of_string_opt str with - | Some n -> Some (Number n) - | None -> None + match String.split_on_char '/' str with + | [num_s; den_s] when num_s <> "" && den_s <> "" -> + (match int_of_string_opt num_s, int_of_string_opt den_s with + | Some n, Some d -> (try Some (make_rat n d) with _ -> None) + | _ -> None) + | _ -> + match int_of_string_opt str with + | Some n -> Some (Integer n) + | None -> + (* handles "nan", "inf", "-inf" *) + match float_of_string_opt str with + | Some n -> Some (Number n) + | None -> None let rec read_value s : value = skip_whitespace_and_comments s; @@ -141,6 +157,13 @@ let rec read_value s : value = advance s; Char (Char.code c) end + | '#' when s.pos + 1 < s.len && + (s.src.[s.pos + 1] = 't' || s.src.[s.pos + 1] = 'f') && + (s.pos + 2 >= s.len || not (is_ident_char s.src.[s.pos + 2])) -> + (* #t / #f — boolean literals (R7RS shorthand) *) + let b = s.src.[s.pos + 1] = 't' in + advance s; advance s; + Bool b | '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = ';' -> (* Datum comment: #; discards next expression *) advance s; advance s; diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index db727a1c..e0ba4d37 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -127,6 +127,46 @@ let rat_div (an, ad) (bn, bd) = if bn = 0 then raise (Eval_error "rational: division by zero"); make_rat (an * bd) (ad * bn) +(* write/display serializers *) +let rec sx_write_val = function + | Nil -> "()" + | Eof -> "#!eof" + | Bool true -> "#t" + | Bool false -> "#f" + | Integer n -> string_of_int n + | Number n -> + let s = Printf.sprintf "%g" n in + (* Ensure float-like if no decimal point *) + if String.contains s '.' || String.contains s 'e' then s else s + | Rational(n, d) -> Printf.sprintf "%d/%d" n d + | String s -> + let buf = Buffer.create (String.length s + 2) in + Buffer.add_char buf '"'; + String.iter (function + | '"' -> Buffer.add_string buf "\\\"" + | '\\' -> Buffer.add_string buf "\\\\" + | '\n' -> Buffer.add_string buf "\\n" + | '\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 + | Char n -> + if n = 32 then "#\\space" + else if n = 10 then "#\\newline" + else if n = 9 then "#\\tab" + else Printf.sprintf "#\\%c" (Char.chr (n land 0xFF)) + | Symbol s -> s + | Keyword k -> ":" ^ k + | List items | ListRef { contents = items } -> + "(" ^ String.concat " " (List.map sx_write_val items) ^ ")" + | v -> inspect v + +and sx_display_val = function + | String s -> s + | Char n -> String.make 1 (Char.chr (n land 0xFF)) + | v -> sx_write_val v + let () = (* === Arithmetic === *) register "+" (fun args -> @@ -2580,3 +2620,71 @@ let () = Bool (!pos < String.length src) | [Port _] -> Bool false | _ -> raise (Eval_error "char-ready?: expected input port")) +; + (* === read / write / display === *) + let rec read_postprocess = function + | List [] -> Nil + | List items -> List (List.map read_postprocess items) + | v -> v + in + register "read" (fun args -> + match args with + | [] -> Eof + | [Port p] -> + (match p.sp_kind with + | PortOutput _ -> raise (Eval_error "read: expected input port") + | PortInput (src, pos) -> + let len = String.length src in + if p.sp_closed || !pos >= len then Eof + else begin + let sub = String.sub src !pos (len - !pos) in + let s = Sx_parser.make_state sub in + Sx_parser.skip_whitespace_and_comments s; + if Sx_parser.at_end s then (pos := len; Eof) + else + (try let form = read_postprocess (Sx_parser.read_value s) in + pos := !pos + s.pos; form + with _ -> pos := len; Eof) + end) + | _ -> raise (Eval_error "read: expected optional input port")); + register "write" (fun args -> + match args with + | [v] -> String (sx_write_val v) + | [v; Port p] -> + (match p.sp_kind with + | PortInput _ -> raise (Eval_error "write: expected output port") + | PortOutput buf -> + if not p.sp_closed then Buffer.add_string buf (sx_write_val v); + Nil) + | _ -> raise (Eval_error "write: expected val [port]")); + register "display" (fun args -> + match args with + | [v] -> String (sx_display_val v) + | [v; Port p] -> + (match p.sp_kind with + | PortInput _ -> raise (Eval_error "display: expected output port") + | PortOutput buf -> + if not p.sp_closed then Buffer.add_string buf (sx_display_val v); + Nil) + | _ -> raise (Eval_error "display: expected val [port]")); + register "newline" (fun args -> + match args with + | [] -> Nil + | [Port p] -> + (match p.sp_kind with + | PortInput _ -> raise (Eval_error "newline: expected output port") + | PortOutput buf -> + if not p.sp_closed then Buffer.add_char buf '\n'; + Nil) + | _ -> raise (Eval_error "newline: expected optional output port")); + register "write-to-string" (fun args -> + match args with + | [v] -> String (sx_write_val v) + | _ -> raise (Eval_error "write-to-string: 1 arg")); + register "display-to-string" (fun args -> + match args with + | [v] -> String (sx_display_val v) + | _ -> raise (Eval_error "display-to-string: 1 arg")); + register "current-input-port" (fun _ -> Nil); + register "current-output-port" (fun _ -> Nil); + register "current-error-port" (fun _ -> Nil) diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 17736e6f..222e7065 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -23,6 +23,13 @@ } return true; } + if (Array.isArray(a) && Array.isArray(b)) { + if (a.length !== b.length) return false; + for (var _j = 0; _j < a.length; _j++) { + if (!sxEq(a[_j], b[_j])) return false; + } + return true; + } if (a && b && a._rational && b._rational) return a._n === b._n && a._d === b._d; if (a && a._rational && typeof b === "number") return b === a._n / a._d; if (b && b._rational && typeof a === "number") return a === b._n / b._d; @@ -34,7 +41,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-05-01T17:11:41Z"; + var SX_VERSION = "2026-05-01T18:13:58Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -657,6 +664,100 @@ if (!p._port || p._kind !== "input") return false; return !p._closed && p._pos < p._source.length; }; + // read/write/display + var _sxBs92 = String.fromCharCode(92); + function sxReadNormalize(src) { + var out = "", i = 0, n = src.length; + while (i < n) { + if (src[i] === '"') { + out += '"'; i++; + while (i < n) { + if (src[i] === _sxBs92 && i+1 < n) { out += src[i]; out += src[i+1]; i += 2; continue; } + if (src[i] === '"') { out += src[i++]; break; } + out += src[i++]; + } + } else if (src[i] === '#' && i+1 < n && (src[i+1] === 't' || src[i+1] === 'f')) { + var nc2 = i+2 < n ? src[i+2] : ''; + if (!nc2 || !/[a-zA-Z0-9_]/.test(nc2)) { + out += (src[i+1] === 't') ? 'true' : 'false'; + i += 2; + } else { out += src[i++]; } + } else { out += src[i++]; } + } + return out; + } + function sxReadConvert(v) { + if (Array.isArray(v) && v.length === 0) return NIL; + if (Array.isArray(v)) return v.map(sxReadConvert); + return v; + } + PRIMITIVES["read"] = function() { + var p = arguments.length > 0 && arguments[0] && arguments[0]._port ? arguments[0] : null; + if (!p || p._kind !== "input" || p._closed) return _eof; + if (!p._forms) { + var sxP = PRIMITIVES["sx-parse"]; + var src = sxReadNormalize(p._source.slice(p._pos || 0)); + p._forms = sxP ? (sxP(src) || []) : []; + p._form_idx = 0; + } + if (p._form_idx >= p._forms.length) return _eof; + return sxReadConvert(p._forms[p._form_idx++]); + }; + var _sxBs = String.fromCharCode(92); + var _sxDq = String.fromCharCode(34); + function sxWriteVal(v, mode) { + if (v === null || v === undefined || v === NIL) return "()"; + if (v && v._eof) return "#!eof"; + if (typeof v === "boolean") return v ? "#t" : "#f"; + if (typeof v === "number") return String(v); + if (v && v._rational) return v._n + "/" + v._d; + if (typeof v === "string") { + if (mode === "display") return v; + return _sxDq + v.split("").map(function(c) { + var n = c.charCodeAt(0); + if (n === 34) return _sxBs + _sxDq; + if (n === 92) return _sxBs + _sxBs; + if (n === 10) return _sxBs + "n"; + if (n === 13) return _sxBs + "r"; + if (n === 9) return _sxBs + "t"; + return c; + }).join("") + _sxDq; + } + if (v && v._char) { + if (mode === "display") return String.fromCodePoint(v.codepoint); + var cp = v.codepoint; + if (cp === 32) return "#" + _sxBs + "space"; + if (cp === 10) return "#" + _sxBs + "newline"; + if (cp === 9) return "#" + _sxBs + "tab"; + return "#" + _sxBs + String.fromCodePoint(cp); + } + if (v && v._sym) return v.name; + if (v && v._kw) return ":" + v.name; + if (Array.isArray(v)) return "(" + v.map(function(x){ return sxWriteVal(x, mode); }).join(" ") + ")"; + return String(v); + } + PRIMITIVES["write"] = function() { + var val = arguments[0], port = arguments[1]; + var s = sxWriteVal(val, "write"); + if (port && port._port && port._kind === "output" && !port._closed) port._buffer += s; + return NIL; + }; + PRIMITIVES["display"] = function() { + var val = arguments[0], port = arguments[1]; + var s = sxWriteVal(val, "display"); + if (port && port._port && port._kind === "output" && !port._closed) port._buffer += s; + return NIL; + }; + PRIMITIVES["newline"] = function() { + var port = arguments[0]; + if (port && port._port && port._kind === "output" && !port._closed) port._buffer += String.fromCharCode(10); + return NIL; + }; + PRIMITIVES["write-to-string"] = function(val) { return sxWriteVal(val, "write"); }; + PRIMITIVES["display-to-string"] = function(val) { return sxWriteVal(val, "display"); }; + PRIMITIVES["current-input-port"] = function() { return NIL; }; + PRIMITIVES["current-output-port"] = function() { return NIL; }; + PRIMITIVES["current-error-port"] = function() { return NIL; }; PRIMITIVES["string-length"] = function(s) { return String(s).length; }; var stringLength = PRIMITIVES["string-length"]; PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; }; @@ -963,6 +1064,7 @@ PRIMITIVES["rational?"] = function(v) { return v instanceof SxRational; }; PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; }; PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; }; + var makeRational = PRIMITIVES["make-rational"]; // stdlib.hash-table @@ -1352,6 +1454,11 @@ var makeChar = PRIMITIVES["make-char"]; var charToInteger = PRIMITIVES["char->integer"]; var isChar = PRIMITIVES["char?"]; + var _readerMacros = {}; + function readerMacroGet(name) { return _readerMacros[name] || false; } + function readerMacroSet(name, fn) { _readerMacros[name] = fn; } + PRIMITIVES["reader-macro-get"] = readerMacroGet; + PRIMITIVES["reader-macro-set!"] = readerMacroSet; // String/number utilities needed by transpiled spec code (content-hash etc) diff --git a/spec/primitives.sx b/spec/primitives.sx index 5ca6c195..8122565f 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -948,6 +948,61 @@ :returns "boolean" :doc "True if a char is immediately available on the port.") + +(define-primitive + "read" + :params (&rest (p :as input-port)) + :returns "any" + :doc "Read one datum from port; returns eof-object at end.") + +(define-primitive + "write" + :params (v &rest (p :as output-port)) + :returns "nil" + :doc "Serialize v to port with quoting — strings quoted, chars as #\\a notation.") + +(define-primitive + "display" + :params (v &rest (p :as output-port)) + :returns "nil" + :doc "Serialize v to port without quoting — strings unquoted, chars as characters.") + +(define-primitive + "newline" + :params (&rest (p :as output-port)) + :returns "nil" + :doc "Write a newline to port.") + +(define-primitive + "write-to-string" + :params (v) + :returns "string" + :doc "Serialize v with write quoting, return as string.") + +(define-primitive + "display-to-string" + :params (v) + :returns "string" + :doc "Serialize v with display format, return as string.") + +(define-primitive + "current-input-port" + :params () + :returns "any" + :doc "Return current default input port.") + +(define-primitive + "current-output-port" + :params () + :returns "any" + :doc "Return current default output port.") + +(define-primitive + "current-error-port" + :params () + :returns "any" + :doc "Return current error port.") + (define-module :stdlib.math) (define-primitive diff --git a/spec/tests/test-read-write.sx b/spec/tests/test-read-write.sx new file mode 100644 index 00000000..37449244 --- /dev/null +++ b/spec/tests/test-read-write.sx @@ -0,0 +1,212 @@ +;; ========================================================================== +;; test-read-write.sx — Tests for read / write / display / newline +;; ========================================================================== + +;; -------------------------------------------------------------------------- +;; read — parse one datum from an input port +;; -------------------------------------------------------------------------- + +(defsuite + "read:basics" + (deftest + "read integer" + (let ((p (open-input-string "42"))) (assert= (read p) 42))) + (deftest + "read float" + (let ((p (open-input-string "3.14"))) (assert= (read p) 3.14))) + (deftest + "read string" + (let ((p (open-input-string "\"hello\""))) (assert= (read p) "hello"))) + (deftest + "read boolean true" + (let ((p (open-input-string "#t"))) (assert (read p)))) + (deftest + "read boolean false" + (let ((p (open-input-string "#f"))) (assert (not (read p))))) + (deftest + "read nil" + (let ((p (open-input-string "()"))) (assert-nil (read p)))) + (deftest + "read list" + (let + ((p (open-input-string "(1 2 3)"))) + (assert= (read p) (list 1 2 3)))) + (deftest + "read nested list" + (let + ((p (open-input-string "(+ 1 (* 2 3))"))) + (assert= + (read p) + (list (quote +) 1 (list (quote *) 2 3)))))) + +;; -------------------------------------------------------------------------- +;; read — eof and multi-read +;; -------------------------------------------------------------------------- + +(defsuite + "read:eof" + (deftest + "read eof returns eof-object" + (let ((p (open-input-string ""))) (assert (eof-object? (read p))))) + (deftest + "read whitespace-only returns eof" + (let ((p (open-input-string " "))) (assert (eof-object? (read p))))) + (deftest + "read two forms" + (let + ((p (open-input-string "1 2"))) + (let + ((a (read p)) (b (read p))) + (assert (and (= a 1) (= b 2)))))) + (deftest + "read returns eof after last form" + (let + ((p (open-input-string "42"))) + (read p) + (assert (eof-object? (read p)))))) + +;; -------------------------------------------------------------------------- +;; write — serialize with quoting +;; -------------------------------------------------------------------------- + +(defsuite + "write:basics" + (deftest "write integer" (assert= (write-to-string 42) "42")) + (deftest + "write negative integer" + (assert= (write-to-string -5) "-5")) + (deftest "write float" (assert= (write-to-string 3.14) "3.14")) + (deftest "write true" (assert= (write-to-string true) "#t")) + (deftest "write false" (assert= (write-to-string false) "#f")) + (deftest "write nil" (assert= (write-to-string nil) "()")) + (deftest + "write string quotes" + (assert= (write-to-string "hello") "\"hello\"")) + (deftest + "write string with escapes" + (assert= (write-to-string "a\"b") "\"a\\\"b\"")) + (deftest + "write list" + (assert= + (write-to-string (list 1 2 3)) + "(1 2 3)")) + (deftest + "write nested list" + (assert= + (write-to-string (list 1 (list 2 3))) + "(1 (2 3))")) + (deftest "write symbol" (assert= (write-to-string (quote foo)) "foo")) + (deftest "write rational" (assert= (write-to-string 1/3) "1/3"))) + +;; -------------------------------------------------------------------------- +;; display — serialize without quoting +;; -------------------------------------------------------------------------- + +(defsuite + "display:basics" + (deftest "display integer" (assert= (display-to-string 42) "42")) + (deftest + "display string no quotes" + (assert= (display-to-string "hello") "hello")) + (deftest "display true" (assert= (display-to-string true) "#t")) + (deftest "display nil" (assert= (display-to-string nil) "()")) + (deftest + "display list" + (assert= + (display-to-string (list 1 2 3)) + "(1 2 3)"))) + +;; -------------------------------------------------------------------------- +;; write vs display distinction +;; -------------------------------------------------------------------------- + +(defsuite + "write-vs-display" + (deftest + "write quotes string, display does not" + (let + ((s "hello")) + (assert + (and + (= (write-to-string s) "\"hello\"") + (= (display-to-string s) "hello"))))) + (deftest + "write and display same for numbers" + (assert= (write-to-string 42) (display-to-string 42))) + (deftest + "write and display same for lists" + (assert= + (write-to-string (list 1 2)) + (display-to-string (list 1 2))))) + +;; -------------------------------------------------------------------------- +;; write/display/newline to port +;; -------------------------------------------------------------------------- + +(defsuite + "write-to-port" + (deftest + "write to output port" + (let + ((p (open-output-string))) + (write 42 p) + (assert= (get-output-string p) "42"))) + (deftest + "display to output port" + (let + ((p (open-output-string))) + (display "hi" p) + (assert= (get-output-string p) "hi"))) + (deftest + "newline to output port" + (let + ((p (open-output-string))) + (newline p) + (assert= (get-output-string p) "\n"))) + (deftest + "write then newline" + (let + ((p (open-output-string))) + (write "hello" p) + (newline p) + (assert= (get-output-string p) "\"hello\"\n"))) + (deftest + "display multiple values" + (let + ((p (open-output-string))) + (display 1 p) + (display " " p) + (display 2 p) + (assert= (get-output-string p) "1 2")))) + +;; -------------------------------------------------------------------------- +;; write round-trip +;; -------------------------------------------------------------------------- + +(defsuite + "write:round-trip" + (deftest + "integer round-trips" + (let + ((p (open-input-string (write-to-string 42)))) + (assert= (read p) 42))) + (deftest + "string round-trips" + (let + ((p (open-input-string (write-to-string "hello world")))) + (assert= (read p) "hello world"))) + (deftest + "list round-trips" + (let + ((p (open-input-string (write-to-string (list 1 2 3))))) + (assert= (read p) (list 1 2 3)))) + (deftest + "boolean true round-trips" + (let + ((p (open-input-string (write-to-string true)))) + (assert (read p)))) + (deftest + "boolean false round-trips" + (let + ((p (open-input-string (write-to-string false)))) + (assert (not (read p)))))) \ No newline at end of file