diff --git a/eval.c b/eval.c index e6fb1434..54b96c41 100644 --- a/eval.c +++ b/eval.c @@ -1954,6 +1954,9 @@ static const char* sexp_initial_features[] = { #if SEXP_USE_DL "dynamic-loading", #endif +#if SEXP_USE_STRING_STREAMS + "string-streams", +#endif #if SEXP_USE_MODULES "modules", #endif diff --git a/lib/chibi/io/io.scm b/lib/chibi/io/io.scm index ddb5f083..775d6180 100644 --- a/lib/chibi/io/io.scm +++ b/lib/chibi/io/io.scm @@ -28,6 +28,17 @@ (display str out) (newline out))) +;;> @subsubsubsection{(write-string str n [out])} + +;;> Writes the first @var{n} bytes of @var{str} to output port +;;> @var{out}. + +(cond-expand + ((not string-streams) + (define (write-string str n . o) + (let ((out (if (pair? o) (car o) (current-output-port)))) + (display (substring str 0 n out)))))) + ;;> @subsubsubsection{(read-line [in [n]])} ;;> Read a line from the input port @var{in}, defaulting to @@ -35,6 +46,21 @@ ;;> a string not including the newline. Reads at most @var{n} ;;> characters, defaulting to 8192. +(cond-expand + ((not string-streams) + (define (%read-line n in) + (let ((out (open-output-string))) + (let lp () + (let ((ch (read-char in))) + (cond + ((eof-object? ch) + (get-output-string out)) + (else + (write-char ch out) + (if (eqv? ch #\newline) + (get-output-string out) + (lp)))))))))) + (define (read-line . o) (let ((in (if (pair? o) (car o) (current-input-port))) (n (if (and (pair? o) (pair? (cdr o))) (car (cdr o)) 8192))) @@ -58,6 +84,15 @@ ;;> than @var{n} characters if the end of file is reached, ;;> or the eof-object if no characters are available. +(cond-expand + ((not string-streams) + (define (%read-string n in) + (let ((out (open-output-string))) + (do ((i 0 (+ i 1)) + (ch (read-char in) (read-char in))) + ((or (= i n) (eof-object? ch)) (get-output-string out)) + (write-char ch out)))))) + (define (read-string n . o) (if (zero? n) "" @@ -80,6 +115,14 @@ ;;> An error is signalled if the length of @var{str} is smaller ;;> than @var{n}. +(cond-expand + ((not string-streams) + (define (%read-string! str n in) + (do ((i 0 (+ i 1)) + (ch (read-char in) (read-char in))) + ((or (= i n) (eof-object? ch)) i) + (string-set! str i ch))))) + (define (read-string! str n . o) (if (>= n (string-length str)) (error "string to small to read chars" str n)) diff --git a/lib/chibi/io/io.stub b/lib/chibi/io/io.stub index 307dd0b3..629d02c0 100644 --- a/lib/chibi/io/io.stub +++ b/lib/chibi/io/io.stub @@ -1,15 +1,17 @@ -(define-c non-null-string (%read-line "fgets") - ((result (array char arg1)) int (default (current-input-port) input-port))) +(cond-expand + (string-streams + (define-c non-null-string (%read-line "fgets") + ((result (array char arg1)) int (default (current-input-port) input-port))) -(define-c size_t (%read-string "fread") - ((result (array char (result arg2))) (value 1 size_t) size_t (default (current-input-port) input-port))) + (define-c size_t (%read-string "fread") + ((result (array char (result arg2))) (value 1 size_t) size_t (default (current-input-port) input-port))) -(define-c size_t (%read-string! "fread") - (string (value 1 size_t) size_t (default (current-input-port) input-port))) + (define-c size_t (%read-string! "fread") + (string (value 1 size_t) size_t (default (current-input-port) input-port))) -(define-c size_t (write-string "fwrite") - (string (value 1 size_t) size_t (default (current-output-port) output-port))) + (define-c size_t (write-string "fwrite") + (string (value 1 size_t) size_t (default (current-output-port) output-port))))) (define-c-const int (seek/set "SEEK_SET")) (define-c-const int (seek/cur "SEEK_CUR"))