123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209 |
- (define-module (ice-9 rdelim)
- #:export (read-line
- read-line!
- read-delimited
- read-delimited!
- read-string
- read-string!
- %read-delimited!
- %read-line
- write-line))
- (%init-rdelim-builtins)
- (define* (read-line! string #:optional (port current-input-port))
-
- (define scm-line-incrementors "\n")
- (let* ((rv (%read-delimited! scm-line-incrementors
- string
- #t
- port))
- (terminator (car rv))
- (nchars (cdr rv)))
- (cond ((and (= nchars 0)
- (eof-object? terminator))
- terminator)
- ((not terminator) #f)
- (else nchars))))
- (define* (read-delimited! delims buf #:optional
- (port (current-input-port)) (handle-delim 'trim)
- (start 0) (end (string-length buf)))
- (let* ((rv (%read-delimited! delims
- buf
- (not (eq? handle-delim 'peek))
- port
- start
- end))
- (terminator (car rv))
- (nchars (cdr rv)))
- (cond ((or (not terminator)
- (eof-object? terminator))
- (if (zero? nchars)
- (if (eq? handle-delim 'split)
- (cons terminator terminator)
- terminator)
- (if (eq? handle-delim 'split)
- (cons nchars terminator)
- nchars)))
- (else
- (case handle-delim
- ((trim peek) nchars)
- ((concat) (string-set! buf (+ nchars start) terminator)
- (+ nchars 1))
- ((split) (cons nchars terminator))
- (else (error "unexpected handle-delim value: "
- handle-delim)))))))
-
- (define* (read-delimited delims #:optional (port (current-input-port))
- (handle-delim 'trim))
- (let loop ((substrings '())
- (total-chars 0)
- (buf-size 100))
- (let* ((buf (make-string buf-size))
- (rv (%read-delimited! delims
- buf
- (not (eq? handle-delim 'peek))
- port))
- (terminator (car rv))
- (nchars (cdr rv))
- (new-total (+ total-chars nchars)))
- (cond
- ((not terminator)
-
- (loop (cons (substring buf 0 nchars) substrings)
- new-total
- (* buf-size 2)))
- ((and (eof-object? terminator) (zero? new-total))
- (if (eq? handle-delim 'split)
- (cons terminator terminator)
- terminator))
- (else
- (let ((joined
- (string-concatenate-reverse
- (cons (substring buf 0 nchars) substrings))))
- (case handle-delim
- ((concat)
- (if (eof-object? terminator)
- joined
- (string-append joined (string terminator))))
- ((trim peek) joined)
- ((split) (cons joined terminator))
- (else (error "unexpected handle-delim value: "
- handle-delim)))))))))
- (define-syntax-rule (check-arg exp message arg ...)
- (unless exp
- (error message arg ...)))
- (define (index? n)
- (and (integer? n) (exact? n) (>= n 0)))
- (define* (read-string! buf #:optional
- (port (current-input-port))
- (start 0) (end (string-length buf)))
- "Read all of the characters out of PORT and write them to BUF.
- Returns the number of characters read.
- This function only reads out characters from PORT if it will be able to
- write them to BUF. That is to say, if BUF is smaller than the number of
- available characters, then BUF will be filled, and characters will be
- left in the port."
- (check-arg (string? buf) "not a string" buf)
- (check-arg (index? start) "bad index" start)
- (check-arg (index? end) "bad index" end)
- (check-arg (<= start end) "start beyond end" start end)
- (check-arg (<= end (string-length buf)) "end beyond string length" end)
- (let lp ((n start))
- (if (< n end)
- (let ((c (read-char port)))
- (if (eof-object? c)
- (- n start)
- (begin
- (string-set! buf n c)
- (lp (1+ n)))))
- (- n start))))
- (define* read-string
- (case-lambda*
- "Read all of the characters out of PORT and return them as a string.
- If the COUNT argument is present, treat it as a limit to the number of
- characters to read. By default, there is no limit."
- ((#:optional (port (current-input-port)))
-
- (let loop ((head (make-string 30)) (pos 0) (tail '()))
- (let ((char (read-char port)))
- (cond
- ((eof-object? char)
- (let ((head (substring head 0 pos)))
- (if (null? tail)
- (substring head 0 pos)
- (string-concatenate-reverse tail head pos))))
- (else
- (string-set! head pos char)
- (if (< (1+ pos) (string-length head))
- (loop head (1+ pos) tail)
- (loop (make-string (* (string-length head) 2)) 0
- (cons head tail))))))))
- ((port count)
-
- (let loop ((chars '())
- (total 0))
- (let ((char (read-char port)))
- (if (or (eof-object? char) (>= total count))
- (list->string (reverse chars))
- (loop (cons char chars) (+ 1 total))))))))
- (define* (read-line #:optional (port (current-input-port))
- (handle-delim 'trim))
- (let* ((line/delim (%read-line port))
- (line (car line/delim))
- (delim (cdr line/delim)))
- (case handle-delim
- ((trim) line)
- ((split) line/delim)
- ((concat) (if (and (string? line) (char? delim))
- (string-append line (string delim))
- line))
- ((peek) (if (char? delim)
- (unread-char delim port))
- line)
- (else
- (error "unexpected handle-delim value: " handle-delim)))))
|