From 1a0d6a2af44393085f032f8c9c02a44666407bd2 Mon Sep 17 00:00:00 2001 From: shivers Date: Fri, 19 Apr 1996 05:51:37 +0000 Subject: [PATCH] Fixed delimited readers -- there was confusion about what the handle-delimiter arg was. It now defaults uniformly to 'trim. --- scsh/fr.scm | 66 ++++++++++++++++++++++++++++--------------------- scsh/rdelim.scm | 38 +++++++++++++--------------- 2 files changed, 55 insertions(+), 49 deletions(-) diff --git a/scsh/fr.scm b/scsh/fr.scm index 12b57ed..077005a 100644 --- a/scsh/fr.scm +++ b/scsh/fr.scm @@ -74,7 +74,7 @@ (define (join-strings strings . args) (if (pair? strings) - (receive (delim grammar) (parse-optionals args " " 'infix) + (let-optionals args ((delim " ") (grammar 'infix)) (check-arg string? delim join-strings) (let ((strings (reverse strings))) (let lp ((strings (cdr strings)) @@ -120,9 +120,9 @@ (define (make-field-parser-generator default-delim-matcher loop-proc) ;; This is the parser-generator (lambda args - (receive (delim-spec num-fields handle-delim) - (parse-optionals args default-delim-matcher #f 'trim) - + (let-optionals args ((delim-spec default-delim-matcher) + (num-fields #f) + (handle-delim 'trim)) ;; Process and error-check the args (let ((match-delim (->delim-matcher delim-spec)) (cons-field (case handle-delim ; Field is s[i,j). @@ -150,7 +150,7 @@ ;; This is the parser. (lambda (s . maybe-start) - (reverse (loop-proc s (optional-arg maybe-start 0) + (reverse (loop-proc s (:optional maybe-start 0) match-delim cons-field num-fields nfields-exact?)))))))) @@ -159,8 +159,8 @@ ;;; (field-splitter [field-spec num-fields]) (define (field-splitter . args) - (receive (field-spec num-fields) - (parse-optionals args default-field-matcher #f) + (let-optionals args ((field-spec default-field-matcher) + (num-fields #f)) ;; Process and error-check the args (let ((match-field (->delim-matcher field-spec))) @@ -174,7 +174,7 @@ ;; This is the parser procedure. (lambda (s . maybe-start) - (reverse (fieldspec-field-loop s (optional-arg maybe-start 0) + (reverse (fieldspec-field-loop s (:optional maybe-start 0) match-field num-fields nfields-exact?))))))) @@ -334,32 +334,44 @@ ;;; (reader [port]) -> string or eof (define (record-reader . args) - (receive (delims elide? handle-delim) - (parse-optionals args default-record-delims #f 'trim) + (let-optionals args ((delims default-record-delims) + (elide? #f) + (handle-delim 'trim)) (let ((delims (->char-set delims))) (case handle-delim ((trim) ; TRIM-delimiter reader. (lambda maybe-port (let ((s (apply read-delimited delims maybe-port))) - (if (not (eof-object? s)) - (if elide? - (apply skip-char-set delims maybe-port) ; Snarf delims. - (apply read-char maybe-port))) ; Just snarf one. + (if (and (not (eof-object? s)) elide?) + (apply skip-char-set delims maybe-port)) ; Snarf extra delims. s))) - ((concat split) ; CONCAT-delimiter & SPLIT-delimiter reader. + ((concat) ; CONCAT-delimiter reader. (let ((not-delims (char-set-invert delims))) (lambda maybe-port - (let ((s (apply read-delimited delims maybe-port))) - (if (eof-object? s) s - (let ((delim (if elide? - (apply read-delimited not-delims maybe-port) - (string (apply read-char maybe-port))))) - (if (eq? handle-delim 'split) - (values s delim) - (if (eof-object? delim) s - (string-append s delim))))))))) + (let* ((p (:optional maybe-port (current-input-port))) + (s (read-delimited delims p 'concat))) + (if (or (not elide?) (eof-object? s)) s + (let ((extra-delims (read-delimited not-delims p 'peek))) + (if (eof-object? extra-delims) s + (string-append s extra-delims)))))))) + + ((split) ; SPLIT-delimiter reader. + (let ((not-delims (char-set-invert delims))) + (lambda maybe-port + (let ((p (:optional maybe-port (current-input-port)))) + (receive (s delim) (read-delimited delims p 'split) + (if (eof-object? s) (values s s) + (values s + (if (or (not elide?) (eof-object? delim)) + delim + ;; Elide: slurp in extra delims. + (let ((delim (string delim)) + (extras (read-delimited not-delims + p 'peek))) + (if (eof-object? extras) delim + (string-append delim extras))))))))))) (else (error "Illegal delimiter-action" handle-delim)))))) @@ -376,8 +388,8 @@ (define default-field-parser (field-splitter)) (define (field-reader . args) - (receive (parser rec-reader) - (parse-optionals args default-field-parser read-line) + (let-optionals args ((parser default-field-parser) + (rec-reader read-line)) (lambda maybe-port (let ((record (apply rec-reader maybe-port))) (if (eof-object? record) @@ -414,5 +426,3 @@ ; (reverse (regexp-reduce string 0 regexp ; (lambda (m ans) (cons (match:substring m 0) ans)) ; '()))) - - diff --git a/scsh/rdelim.scm b/scsh/rdelim.scm index cbf6e9e..d21ed1e 100644 --- a/scsh/rdelim.scm +++ b/scsh/rdelim.scm @@ -28,9 +28,8 @@ ;;; 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-optionals args ((port (current-input-port)) + (delim-action 'trim)) (let ((substr (lambda (s end) ; Smart substring. (if (= end (string-length s)) s (substring s 0 end)))) @@ -94,10 +93,10 @@ ;;; 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)) - + (let-optionals args ((port (current-input-port)) + (delim-action 'trim) + (start 0) + (end (string-length buf))) (receive (terminator num-read) (%read-delimited! delims buf (not (eq? delim-action 'peek)) ;Gobble delim? @@ -108,14 +107,14 @@ end)) (if terminator ; Check for buffer overflow. - (let ((retval (if (and (eof-object? terminator) - (zero? num-read)) + (let ((retval (if (and (zero? num-read) + (eof-object? terminator)) terminator ; EOF -- got nothing. num-read))) ; Got something. (case delim-action - ((split) (values retval terminator)) ((peek trim) retval) + ((split) (values retval terminator)) ((concat) (cond ((char? terminator) (string-set! buf (+ start num-read) terminator) (+ num-read 1)) @@ -123,8 +122,8 @@ ;; Buffer overflow. (case delim-action - ((split) (values #f #f)) ((peek trim) #f) + ((split) (values #f #f)) ((concat) (let ((last (read-char port))) (if (char? last) (string-set! buf (+ start num-read) last)) @@ -156,8 +155,9 @@ ;;; operation. (define (%read-delimited! delims buf gobble? . args) - (receive (port start end) - (parse-optionals args (current-input-port) 0 (string-length buf)) + (let-optionals args ((port (current-input-port)) + (start 0) + (end (string-length buf))) (check-arg input-port? port %read-delimited!) ; Arg checking. (check-arg char-set? delims %read-delimited!) ; Required, since @@ -219,7 +219,7 @@ (define (skip-char-set skip-chars . maybe-port) - (let ((port (optional-arg maybe-port (current-input-port))) + (let ((port (:optional maybe-port (current-input-port))) (cset (->char-set skip-chars))) (cond ((not (input-port? port)) @@ -250,10 +250,7 @@ (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))) +(define (read-line . rest) (apply read-delimited charset:newline rest)) ;;; (read-paragraph [port handle-delim]) @@ -262,9 +259,8 @@ (define blank-line-regexp (make-regexp "^[ \t]*\n$")) (define (read-paragraph . args) - (receive (port handle-delim) - (parse-optionals args (current-input-port) 'trim) - + (let-optionals args ((port (current-input-port)) + (handle-delim 'trim)) ;; First, skip all blank lines. (let lp () (let ((line (read-line port 'concat)))