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:
@@ -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;
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user