diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 3b72f2ec..91c2d9a7 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -1392,6 +1392,8 @@ let rec dispatch env cmd = | SxExpr s -> s | RawHTML s -> "\"" ^ escape_sx_string s ^ "\"" | Char n -> Sx_types.inspect (Char n) + | Eof -> Sx_types.inspect Eof + | Port _ -> Sx_types.inspect result | _ -> "nil" in send_ok_raw (raw_serialize result) diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 106c09ef..69a088ec 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -2301,4 +2301,109 @@ let () = | v -> raise (Eval_error ("list->string: expected char, got " ^ type_of v)) ) chars; String (Buffer.contents buf) - | _ -> raise (Eval_error "list->string: expected list of chars")) + | _ -> raise (Eval_error "list->string: expected list of chars")); + (* Phase 14 — EOF object + string ports *) + register "eof-object" (fun _args -> Eof); + register "eof-object?" (fun args -> + match args with + | [Eof] -> Bool true + | [_] -> Bool false + | _ -> raise (Eval_error "eof-object?: expected 1 argument")); + register "open-input-string" (fun args -> + match args with + | [String s] -> + Port { sp_closed = false; sp_kind = PortInput (s, ref 0) } + | _ -> raise (Eval_error "open-input-string: expected string")); + register "open-output-string" (fun args -> + match args with + | [] -> Port { sp_closed = false; sp_kind = PortOutput (Buffer.create 64) } + | _ -> raise (Eval_error "open-output-string: expected no arguments")); + register "get-output-string" (fun args -> + match args with + | [Port { sp_kind = PortOutput buf; _ }] -> String (Buffer.contents buf) + | _ -> raise (Eval_error "get-output-string: expected output port")); + register "port?" (fun args -> + match args with + | [Port _] -> Bool true + | [_] -> Bool false + | _ -> raise (Eval_error "port?: expected 1 argument")); + register "input-port?" (fun args -> + match args with + | [Port { sp_kind = PortInput _; _ }] -> Bool true + | [_] -> Bool false + | _ -> raise (Eval_error "input-port?: expected 1 argument")); + register "output-port?" (fun args -> + match args with + | [Port { sp_kind = PortOutput _; _ }] -> Bool true + | [_] -> Bool false + | _ -> raise (Eval_error "output-port?: expected 1 argument")); + register "close-port" (fun args -> + match args with + | [Port p] -> p.sp_closed <- true; Nil + | _ -> raise (Eval_error "close-port: expected port")); + register "read-char" (fun args -> + match args with + | [] -> raise (Eval_error "read-char: no default port in this host") + | [Port p] -> + (match p.sp_kind with + | PortOutput _ -> raise (Eval_error "read-char: expected input port") + | PortInput (src, pos) -> + if p.sp_closed || !pos >= String.length src then Eof + else begin + let cp = Char.code src.[!pos] in + incr pos; + Char cp + end) + | _ -> raise (Eval_error "read-char: expected input port")); + register "peek-char" (fun args -> + match args with + | [] -> raise (Eval_error "peek-char: no default port in this host") + | [Port p] -> + (match p.sp_kind with + | PortOutput _ -> raise (Eval_error "peek-char: expected input port") + | PortInput (src, pos) -> + if p.sp_closed || !pos >= String.length src then Eof + else Char (Char.code src.[!pos])) + | _ -> raise (Eval_error "peek-char: expected input port")); + register "read-line" (fun args -> + match args with + | [] -> raise (Eval_error "read-line: no default port in this host") + | [Port p] -> + (match p.sp_kind with + | PortOutput _ -> raise (Eval_error "read-line: expected input port") + | PortInput (src, pos) -> + if p.sp_closed || !pos >= String.length src then Eof + else begin + let start = !pos in + let len = String.length src in + while !pos < len && src.[!pos] <> '\n' do incr pos done; + let line = String.sub src start (!pos - start) in + if !pos < len then incr pos; + String line + end) + | _ -> raise (Eval_error "read-line: expected input port")); + register "write-char" (fun args -> + match args with + | [Char n; Port p] -> + (match p.sp_kind with + | PortInput _ -> raise (Eval_error "write-char: expected output port") + | PortOutput buf -> + if not p.sp_closed then + Buffer.add_char buf (Char.chr (n land 0xFF)); + Nil) + | _ -> raise (Eval_error "write-char: expected char and output port")); + register "write-string" (fun args -> + match args with + | [String s; Port p] -> + (match p.sp_kind with + | PortInput _ -> raise (Eval_error "write-string: expected output port") + | PortOutput buf -> + if not p.sp_closed then Buffer.add_string buf s; + Nil) + | _ -> raise (Eval_error "write-string: expected string and output port")); + register "char-ready?" (fun args -> + match args with + | [Port { sp_closed = false; sp_kind = PortInput (src, pos); _ }] -> + Bool (!pos < String.length src) + | [Port _] -> Bool false + | _ -> raise (Eval_error "char-ready?: expected input port")) diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index dd54ac9c..81f94b3f 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -76,6 +76,18 @@ and value = | StringBuffer of Buffer.t (** Mutable string buffer — O(1) amortized append. *) | HashTable of (value, value) Hashtbl.t (** Mutable hash table with arbitrary keys. *) | Char of int (** Unicode codepoint — R7RS char type. *) + | Eof (** EOF sentinel — returned by read-char etc. at end of input. *) + | Port of sx_port (** String port — input (string cursor) or output (buffer). *) + +(** String input port: source string + mutable cursor position. *) +and sx_port_kind = + | PortInput of string * int ref + | PortOutput of Buffer.t + +and sx_port = { + mutable sp_closed : bool; + sp_kind : sx_port_kind; +} (** CEK machine state — record instead of Dict for performance. 5 fields × 55K steps/sec = 275K Hashtbl allocations/sec eliminated. *) @@ -497,6 +509,9 @@ let type_of = function | StringBuffer _ -> "string-buffer" | HashTable _ -> "hash-table" | Char _ -> "char" + | Eof -> "eof-object" + | Port { sp_kind = PortInput _; _ } -> "input-port" + | Port { sp_kind = PortOutput _; _ } -> "output-port" let is_nil = function Nil -> true | _ -> false let is_lambda = function Lambda _ -> true | _ -> false @@ -853,3 +868,8 @@ let rec inspect = function Buffer.add_utf_8_uchar buf (Uchar.of_int n); Buffer.contents buf in "#\\" ^ name + | Eof -> "#!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 "")