mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 06:09:18 +02:00
Providing scheme versions of some I/O functions when string streams aren't used.
This commit is contained in:
parent
620eba1169
commit
24b43e367b
3 changed files with 56 additions and 8 deletions
3
eval.c
3
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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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"))
|
||||
|
|
Loading…
Add table
Reference in a new issue