spec: read/write/display — S-expression reader/writer on ports
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 <noreply@anthropic.com>
This commit is contained in:
@@ -849,6 +849,13 @@ PREAMBLE = '''\
|
|||||||
}
|
}
|
||||||
return true;
|
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 && 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 (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;
|
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;
|
if (!p._port || p._kind !== "input") return false;
|
||||||
return !p._closed && p._pos < p._source.length;
|
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; };
|
PRIMITIVES["string-length"] = function(s) { return String(s).length; };
|
||||||
var stringLength = PRIMITIVES["string-length"];
|
var stringLength = PRIMITIVES["string-length"];
|
||||||
PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; };
|
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["rational?"] = function(v) { return v instanceof SxRational; };
|
||||||
PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; };
|
PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; };
|
||||||
PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; };
|
PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; };
|
||||||
|
var makeRational = PRIMITIVES["make-rational"];
|
||||||
''',
|
''',
|
||||||
"stdlib.hash-table": '''
|
"stdlib.hash-table": '''
|
||||||
// stdlib.hash-table
|
// stdlib.hash-table
|
||||||
@@ -2294,6 +2396,11 @@ PLATFORM_PARSER_JS = r"""
|
|||||||
var makeChar = PRIMITIVES["make-char"];
|
var makeChar = PRIMITIVES["make-char"];
|
||||||
var charToInteger = PRIMITIVES["char->integer"];
|
var charToInteger = PRIMITIVES["char->integer"];
|
||||||
var isChar = PRIMITIVES["char?"];
|
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;
|
||||||
"""
|
"""
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -89,8 +89,18 @@ let read_symbol s =
|
|||||||
while s.pos < s.len && is_symbol_char s.src.[s.pos] do advance s done;
|
while s.pos < s.len && is_symbol_char s.src.[s.pos] do advance s done;
|
||||||
String.sub s.src start (s.pos - start)
|
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 =
|
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_dec = String.contains str '.' in
|
||||||
let has_exp = String.contains str 'e' || String.contains str 'E' in
|
let has_exp = String.contains str 'e' || String.contains str 'E' in
|
||||||
if has_dec || has_exp then
|
if has_dec || has_exp then
|
||||||
@@ -98,13 +108,19 @@ let try_number str =
|
|||||||
| Some n -> Some (Number n)
|
| Some n -> Some (Number n)
|
||||||
| None -> None
|
| None -> None
|
||||||
else
|
else
|
||||||
match int_of_string_opt str with
|
match String.split_on_char '/' str with
|
||||||
| Some n -> Some (Integer n)
|
| [num_s; den_s] when num_s <> "" && den_s <> "" ->
|
||||||
| None ->
|
(match int_of_string_opt num_s, int_of_string_opt den_s with
|
||||||
(* handles "nan", "inf", "-inf" *)
|
| Some n, Some d -> (try Some (make_rat n d) with _ -> None)
|
||||||
match float_of_string_opt str with
|
| _ -> None)
|
||||||
| Some n -> Some (Number n)
|
| _ ->
|
||||||
| 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 =
|
let rec read_value s : value =
|
||||||
skip_whitespace_and_comments s;
|
skip_whitespace_and_comments s;
|
||||||
@@ -141,6 +157,13 @@ let rec read_value s : value =
|
|||||||
advance s;
|
advance s;
|
||||||
Char (Char.code c)
|
Char (Char.code c)
|
||||||
end
|
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] = ';' ->
|
| '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = ';' ->
|
||||||
(* Datum comment: #; discards next expression *)
|
(* Datum comment: #; discards next expression *)
|
||||||
advance s; advance s;
|
advance s; advance s;
|
||||||
|
|||||||
@@ -127,6 +127,46 @@ let rat_div (an, ad) (bn, bd) =
|
|||||||
if bn = 0 then raise (Eval_error "rational: division by zero");
|
if bn = 0 then raise (Eval_error "rational: division by zero");
|
||||||
make_rat (an * bd) (ad * bn)
|
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 () =
|
let () =
|
||||||
(* === Arithmetic === *)
|
(* === Arithmetic === *)
|
||||||
register "+" (fun args ->
|
register "+" (fun args ->
|
||||||
@@ -2580,3 +2620,71 @@ let () =
|
|||||||
Bool (!pos < String.length src)
|
Bool (!pos < String.length src)
|
||||||
| [Port _] -> Bool false
|
| [Port _] -> Bool false
|
||||||
| _ -> raise (Eval_error "char-ready?: expected input port"))
|
| _ -> 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)
|
||||||
|
|||||||
@@ -23,6 +23,13 @@
|
|||||||
}
|
}
|
||||||
return true;
|
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 && 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 (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;
|
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 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 isNil(x) { return x === NIL || x === null || x === undefined; }
|
||||||
function isSxTruthy(x) { return x !== false && !isNil(x); }
|
function isSxTruthy(x) { return x !== false && !isNil(x); }
|
||||||
@@ -657,6 +664,100 @@
|
|||||||
if (!p._port || p._kind !== "input") return false;
|
if (!p._port || p._kind !== "input") return false;
|
||||||
return !p._closed && p._pos < p._source.length;
|
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; };
|
PRIMITIVES["string-length"] = function(s) { return String(s).length; };
|
||||||
var stringLength = PRIMITIVES["string-length"];
|
var stringLength = PRIMITIVES["string-length"];
|
||||||
PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; };
|
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["rational?"] = function(v) { return v instanceof SxRational; };
|
||||||
PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; };
|
PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; };
|
||||||
PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; };
|
PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; };
|
||||||
|
var makeRational = PRIMITIVES["make-rational"];
|
||||||
|
|
||||||
|
|
||||||
// stdlib.hash-table
|
// stdlib.hash-table
|
||||||
@@ -1352,6 +1454,11 @@
|
|||||||
var makeChar = PRIMITIVES["make-char"];
|
var makeChar = PRIMITIVES["make-char"];
|
||||||
var charToInteger = PRIMITIVES["char->integer"];
|
var charToInteger = PRIMITIVES["char->integer"];
|
||||||
var isChar = PRIMITIVES["char?"];
|
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)
|
// String/number utilities needed by transpiled spec code (content-hash etc)
|
||||||
|
|||||||
@@ -948,6 +948,61 @@
|
|||||||
:returns "boolean"
|
:returns "boolean"
|
||||||
:doc "True if a char is immediately available on the port.")
|
: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-module :stdlib.math)
|
||||||
|
|
||||||
(define-primitive
|
(define-primitive
|
||||||
|
|||||||
212
spec/tests/test-read-write.sx
Normal file
212
spec/tests/test-read-write.sx
Normal file
@@ -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))))))
|
||||||
Reference in New Issue
Block a user