273 lines
9.7 KiB
Scheme
273 lines
9.7 KiB
Scheme
|
;;; Delimited readers
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; These procedures run their inner I/O loop in a C primitive, so they
|
||
|
|
;;; should be quite fast.
|
||
|
|
;;;
|
||
|
|
;;; N.B.:
|
||
|
|
;;; The C primitive %READ-DELIMITED-FDPORT!/ERRNO relies on knowing the
|
||
|
|
;;; representation of character sets. If these are changed from their
|
||
|
|
;;; current representation as 256-element strings, this code must be changed
|
||
|
|
;;; as well.
|
||
|
|
|
||
|
|
;;; (read-delimited delims [port delim-action])
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; Returns a string or the EOF object. DELIM-ACTION determines what to do
|
||
|
|
;;; with the terminating delimiter:
|
||
|
|
;;; - PEEK
|
||
|
|
;;; Leave it in the input stream for later reading.
|
||
|
|
;;; - TRIM (the default)
|
||
|
|
;;; Drop it on the floor.
|
||
|
|
;;; - CONCAT
|
||
|
|
;;; Append it to the returned string.
|
||
|
|
;;; - SPLIT
|
||
|
|
;;; Return it as a second return value.
|
||
|
|
;;;
|
||
|
|
;;; We repeatedly allocate a buffer and fill it with READ-DELIMITED!
|
||
|
|
;;; until we hit a delimiter or EOF. Each time through the loop, we
|
||
|
|
;;; double the total buffer space, so the loop terminates with a log
|
||
|
|
;;; number of reads, but uses at most double the optimal buffer space.
|
||
|
|
|
||
|
|
(define (read-delimited delims . args)
|
||
|
|
(receive (port delim-action)
|
||
|
|
(parse-optionals args (current-input-port) 'trim)
|
||
|
|
|
||
|
|
(let ((substr (lambda (s end) ; Smart substring.
|
||
|
|
(if (= end (string-length s)) s
|
||
|
|
(substring s 0 end))))
|
||
|
|
(delims (->char-set delims))
|
||
|
|
(gobble? (not (eq? delim-action 'peek))))
|
||
|
|
|
||
|
|
;; BUFLEN is total amount of buffer space allocated to date.
|
||
|
|
(let lp ((strs '()) (buflen 80) (buf (make-string 80)))
|
||
|
|
(receive (terminator num-read)
|
||
|
|
(%read-delimited! delims buf gobble? port)
|
||
|
|
(if terminator
|
||
|
|
|
||
|
|
;; We are done. NUM-READ is either a read count or EOF.
|
||
|
|
(let ((retval (if (and (zero? num-read)
|
||
|
|
(eof-object? terminator)
|
||
|
|
(null? strs))
|
||
|
|
terminator ; EOF -- got nothing.
|
||
|
|
|
||
|
|
;; Got something. Stick all the strings
|
||
|
|
;; together, plus the terminator if the
|
||
|
|
;; client said 'CONCAT.
|
||
|
|
(let ((s (substr buf num-read)))
|
||
|
|
(cond ((and (eq? delim-action 'concat)
|
||
|
|
(char? terminator))
|
||
|
|
(apply string-append
|
||
|
|
(reverse `(,(string terminator)
|
||
|
|
,s . ,strs))))
|
||
|
|
|
||
|
|
((null? strs) s) ; Gratuitous opt.
|
||
|
|
(else (apply string-append
|
||
|
|
(reverse (cons s strs)))))))))
|
||
|
|
(if (eq? delim-action 'split)
|
||
|
|
(values retval terminator)
|
||
|
|
retval))
|
||
|
|
|
||
|
|
;; We are not done. Loop and read in some more.
|
||
|
|
(lp (cons buf strs)
|
||
|
|
(+ buflen buflen)
|
||
|
|
(make-string buflen))))))))
|
||
|
|
|
||
|
|
|
||
|
|
;;; (read-delimited! delims buf [port delim-action start end])
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; Returns:
|
||
|
|
;;; - EOF if at end of file, and a non-zero read was requested.
|
||
|
|
;;; - Integer j if that many chars read into BUF.
|
||
|
|
;;; - #f if the buffer was filled w/o finding a delimiter.
|
||
|
|
;;;
|
||
|
|
;;; DELIM-ACTION determines what to do with the terminating delimiter;
|
||
|
|
;;; it is as in READ-DELIMITED.
|
||
|
|
;;;
|
||
|
|
;;; In determining the return value, there is an ambiguous case: when the
|
||
|
|
;;; buffer is full, *and* the following char is a delimiter char or EOF.
|
||
|
|
;;; Ties are broken favoring termination over #f -- after filling the buffer,
|
||
|
|
;;; READ-DELIMITED! won't return #f until it has peeked one past the end
|
||
|
|
;;; of the buffer to ensure the next char doesn't terminate input (or is EOF).
|
||
|
|
;;; However, this rule is relaxed with delim-action = CONCAT -- if the buffer
|
||
|
|
;;; is full, READ-DELIMITED! won't wait around trying to peek at the following
|
||
|
|
;;; char to determine whether or not it is a delimiter char, since it doesn't
|
||
|
|
;;; have space to store the character anyway. It simply immediately returns #f;
|
||
|
|
;;; a following read can pick up the delimiter char.
|
||
|
|
|
||
|
|
(define (read-delimited! delims buf . args) ; [port delim-action start end]
|
||
|
|
(receive (port delim-action start end)
|
||
|
|
(parse-optionals args (current-input-port) 'peek
|
||
|
|
0 (string-length buf))
|
||
|
|
|
||
|
|
(receive (terminator num-read)
|
||
|
|
(%read-delimited! delims buf
|
||
|
|
(not (eq? delim-action 'peek)) ;Gobble delim?
|
||
|
|
port
|
||
|
|
start
|
||
|
|
(if (eq? delim-action 'concat)
|
||
|
|
(- end 1) ; Room for terminator.
|
||
|
|
end))
|
||
|
|
|
||
|
|
(if terminator ; Check for buffer overflow.
|
||
|
|
(let ((retval (if (and (eof-object? terminator)
|
||
|
|
(zero? num-read))
|
||
|
|
terminator ; EOF -- got nothing.
|
||
|
|
num-read))) ; Got something.
|
||
|
|
|
||
|
|
(case delim-action
|
||
|
|
((split) (values retval terminator))
|
||
|
|
((peek trim) retval)
|
||
|
|
((concat) (cond ((char? terminator)
|
||
|
|
(string-set! buf (+ start num-read) terminator)
|
||
|
|
(+ num-read 1))
|
||
|
|
(else retval)))))
|
||
|
|
|
||
|
|
;; Buffer overflow.
|
||
|
|
(case delim-action
|
||
|
|
((split) (values #f #f))
|
||
|
|
((peek trim) #f)
|
||
|
|
((concat) (let ((last (read-char port)))
|
||
|
|
(if (char? last)
|
||
|
|
(string-set! buf (+ start num-read) last))
|
||
|
|
(and (or (eof-object? last)
|
||
|
|
(char-set-contains? (->char-set delims)
|
||
|
|
last))
|
||
|
|
(+ num-read 1)))))))))
|
||
|
|
|
||
|
|
|
||
|
|
;;; (%read-delimited! delims buf gobble? [port start end])
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; This low-level routine uses a different interface. It returns two values:
|
||
|
|
;;; - TERMINATOR: A value describing why the read was terminated:
|
||
|
|
;;; + character or eof-object => read terminated by this value;
|
||
|
|
;;; + #f => filled buffer w/o terminating read.
|
||
|
|
;;; - NUM-READ: Number of chars read into buf.
|
||
|
|
;;;
|
||
|
|
;;; Note:
|
||
|
|
;;; - Invariant: TERMINATOR = #f => NUM-READ = END - START.
|
||
|
|
;;; - Invariant: TERMINATOR = eof-object and NUM-READ = 0 => at EOF.
|
||
|
|
;;; - When determining the TERMINATOR return value, ties are broken
|
||
|
|
;;; favoring character or the eof-object over #f. That is, if the buffer
|
||
|
|
;;; fills up, %READ-DELIMITED! will peek at one more character from the
|
||
|
|
;;; input stream to determine if it terminates the input. If so, that
|
||
|
|
;;; is returned, not #f.
|
||
|
|
;;;
|
||
|
|
;;; If GOBBLE? is true, then a terminator character is removed from
|
||
|
|
;;; the input stream. Otherwise, it is left in place for a following input
|
||
|
|
;;; operation.
|
||
|
|
|
||
|
|
(define (%read-delimited! delims buf gobble? . args)
|
||
|
|
(receive (port start end)
|
||
|
|
(parse-optionals args (current-input-port) 0 (string-length buf))
|
||
|
|
|
||
|
|
(check-arg input-port? port %read-delimited!) ; Arg checking.
|
||
|
|
(check-arg char-set? delims %read-delimited!) ; Required, since
|
||
|
|
(if (bogus-substring-spec? buf start end) ; we're calling C.
|
||
|
|
(error "Illegal START/END substring indices"
|
||
|
|
buf start end %read-delimited!))
|
||
|
|
|
||
|
|
(let ((delims (->char-set delims)))
|
||
|
|
|
||
|
|
(if (fdport? port)
|
||
|
|
|
||
|
|
;; Direct C support for Unix file ports -- zippy quick.
|
||
|
|
(receive (terminator num-read)
|
||
|
|
(%read-delimited-fdport!/errno delims buf gobble?
|
||
|
|
port start end)
|
||
|
|
(if (integer? terminator)
|
||
|
|
(errno-error terminator %read-delimited! num-read
|
||
|
|
delims buf gobble? port start end)
|
||
|
|
(values terminator num-read)))
|
||
|
|
|
||
|
|
;; This is the code for other kinds of ports.
|
||
|
|
;; Mighty slow -- we read each char twice (peek first, then read).
|
||
|
|
(let lp ((i start))
|
||
|
|
(let ((c (peek-char port)))
|
||
|
|
(cond ((or (eof-object? c) ; Found terminating char or eof
|
||
|
|
(char-set-contains? delims c))
|
||
|
|
(if gobble? (read-char port))
|
||
|
|
(values c (- i start)))
|
||
|
|
|
||
|
|
((>= i end) ; Filled the buffer.
|
||
|
|
(if gobble? (read-char port))
|
||
|
|
(values #f (- i start)))
|
||
|
|
|
||
|
|
(else (string-set! buf i (read-char port))
|
||
|
|
(lp (+ i 1))))))))))
|
||
|
|
|
||
|
|
|
||
|
|
(define-foreign %read-delimited-fdport!/errno (read_delim (string delims)
|
||
|
|
(var-string buf)
|
||
|
|
(bool gobble?)
|
||
|
|
(desc port)
|
||
|
|
(fixnum start)
|
||
|
|
(fixnum end))
|
||
|
|
desc ; int => errno; char => terminating char; eof-object; #f => buf ovflow
|
||
|
|
fixnum) ; number of chars read into BUF.
|
||
|
|
|
||
|
|
|
||
|
|
;;; This is probably a hell of lot slower than actually reading the string
|
||
|
|
;;; into a buffer and throwing it away, due to the painful slowness of
|
||
|
|
;;; the current char-at-a-time Scheme input.
|
||
|
|
|
||
|
|
(define (skip-char-set cset . maybe-port)
|
||
|
|
(let ((port (optional-arg maybe-port (current-input-port))))
|
||
|
|
(let lp ()
|
||
|
|
(let ((c (peek-char port)))
|
||
|
|
(cond ((and (char? c) (char-set-contains? cset c))
|
||
|
|
(read-char port)
|
||
|
|
(lp))
|
||
|
|
(else c))))))
|
||
|
|
|
||
|
|
|
||
|
|
;;; (read-line [port delim-action])
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; Read in a line of data. Input is terminated by either a newline or EOF.
|
||
|
|
;;; The newline is trimmed from the string by default.
|
||
|
|
|
||
|
|
(define charset:newline (char-set #\newline))
|
||
|
|
|
||
|
|
(define (read-line . rest)
|
||
|
|
(receive (port delim-action)
|
||
|
|
(parse-optionals rest (current-input-port) 'trim)
|
||
|
|
(read-delimited charset:newline port delim-action)))
|
||
|
|
|
||
|
|
|
||
|
|
;;; (read-paragraph [port handle-delim])
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
(define blank-line-regexp (make-regexp "^[ \t]*\n$"))
|
||
|
|
|
||
|
|
(define (read-paragraph . args)
|
||
|
|
(receive (port handle-delim)
|
||
|
|
(parse-optionals args (current-input-port) 'trim)
|
||
|
|
|
||
|
|
;; First, skip all blank lines.
|
||
|
|
(let lp ()
|
||
|
|
(let ((line (read-line port 'concat)))
|
||
|
|
(cond ((eof-object? line)
|
||
|
|
(if (eq? handle-delim 'split) (values line line) line))
|
||
|
|
|
||
|
|
((regexp-exec blank-line-regexp line) (lp))
|
||
|
|
|
||
|
|
;; Then, read in non-blank lines.
|
||
|
|
(else
|
||
|
|
(let lp ((lines (list line)))
|
||
|
|
(let ((line (read-line port 'concat)))
|
||
|
|
(if (and (string? line)
|
||
|
|
(not (regexp-exec blank-line-regexp line)))
|
||
|
|
|
||
|
|
(lp (cons line lines))
|
||
|
|
|
||
|
|
;; Return the paragraph
|
||
|
|
(let ((->str (lambda (lns) (apply string-append (reverse lns)))))
|
||
|
|
(case handle-delim
|
||
|
|
((trim) (->str lines))
|
||
|
|
|
||
|
|
((concat)
|
||
|
|
(->str (if (eof-object? line) lines (cons line lines))))
|
||
|
|
|
||
|
|
((split)
|
||
|
|
(values (->str lines) line))
|
||
|
|
|
||
|
|
(else (error "Illegal HANDLE-DELIM parameter to READ-PARAGRAPH")))))))))))))
|