scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fixed delimited readers -- there was confusion about what the handle-delimiter 

arg was. It now defaults uniformly to 'trim.
This commit is contained in:
shivers 1996-04-19 05:51:37 +00:00
parent 16c0d2ef3f
commit 1a0d6a2af4
2 changed files with 55 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
scsh/fr.scm
View File

@ -74,7 +74,7 @@
(define (join-strings strings . args) (define (join-strings strings . args)
(if (pair? strings) (if (pair? strings)
(receive (delim grammar) (parse-optionals args " " 'infix) (let-optionals args ((delim " ") (grammar 'infix))
(check-arg string? delim join-strings) (check-arg string? delim join-strings)
(let ((strings (reverse strings))) (let ((strings (reverse strings)))
(let lp ((strings (cdr strings)) (let lp ((strings (cdr strings))
@ -120,9 +120,9 @@
(define (make-field-parser-generator default-delim-matcher loop-proc) (define (make-field-parser-generator default-delim-matcher loop-proc)
;; This is the parser-generator ;; This is the parser-generator
(lambda args (lambda args
(receive (delim-spec num-fields handle-delim) (let-optionals args ((delim-spec default-delim-matcher)
(parse-optionals args default-delim-matcher #f 'trim) (num-fields #f)
(handle-delim 'trim))
;; Process and error-check the args ;; Process and error-check the args
(let ((match-delim (->delim-matcher delim-spec)) (let ((match-delim (->delim-matcher delim-spec))
(cons-field (case handle-delim ; Field is s[i,j). (cons-field (case handle-delim ; Field is s[i,j).
@ -150,7 +150,7 @@
;; This is the parser. ;; This is the parser.
(lambda (s . maybe-start) (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 match-delim cons-field
num-fields nfields-exact?)))))))) num-fields nfields-exact?))))))))
@ -159,8 +159,8 @@
;;; (field-splitter [field-spec num-fields]) ;;; (field-splitter [field-spec num-fields])
(define (field-splitter . args) (define (field-splitter . args)
(receive (field-spec num-fields) (let-optionals args ((field-spec default-field-matcher)
(parse-optionals args default-field-matcher #f) (num-fields #f))
;; Process and error-check the args ;; Process and error-check the args
(let ((match-field (->delim-matcher field-spec))) (let ((match-field (->delim-matcher field-spec)))
@ -174,7 +174,7 @@
;; This is the parser procedure. ;; This is the parser procedure.
(lambda (s . maybe-start) (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?))))))) match-field num-fields nfields-exact?)))))))
@ -334,32 +334,44 @@
;;; (reader [port]) -> string or eof ;;; (reader [port]) -> string or eof
(define (record-reader . args) (define (record-reader . args)
(receive (delims elide? handle-delim) (let-optionals args ((delims default-record-delims)
(parse-optionals args default-record-delims #f 'trim) (elide? #f)
(handle-delim 'trim))
(let ((delims (->char-set delims))) (let ((delims (->char-set delims)))
(case handle-delim (case handle-delim
((trim) ; TRIM-delimiter reader. ((trim) ; TRIM-delimiter reader.
(lambda maybe-port (lambda maybe-port
(let ((s (apply read-delimited delims maybe-port))) (let ((s (apply read-delimited delims maybe-port)))
(if (not (eof-object? s)) (if (and (not (eof-object? s)) elide?)
(if elide? (apply skip-char-set delims maybe-port)) ; Snarf extra delims.
(apply skip-char-set delims maybe-port) ; Snarf delims.
(apply read-char maybe-port))) ; Just snarf one.
s))) s)))
((concat split) ; CONCAT-delimiter & SPLIT-delimiter reader. ((concat) ; CONCAT-delimiter reader.
(let ((not-delims (char-set-invert delims))) (let ((not-delims (char-set-invert delims)))
(lambda maybe-port (lambda maybe-port
(let ((s (apply read-delimited delims maybe-port))) (let* ((p (:optional maybe-port (current-input-port)))
(if (eof-object? s) s (s (read-delimited delims p 'concat)))
(let ((delim (if elide? (if (or (not elide?) (eof-object? s)) s
(apply read-delimited not-delims maybe-port) (let ((extra-delims (read-delimited not-delims p 'peek)))
(string (apply read-char maybe-port))))) (if (eof-object? extra-delims) s
(if (eq? handle-delim 'split) (string-append s extra-delims))))))))
(values s delim)
(if (eof-object? delim) s ((split) ; SPLIT-delimiter reader.
(string-append s delim))))))))) (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 (else
(error "Illegal delimiter-action" handle-delim)))))) (error "Illegal delimiter-action" handle-delim))))))
@ -376,8 +388,8 @@
(define default-field-parser (field-splitter)) (define default-field-parser (field-splitter))
(define (field-reader . args) (define (field-reader . args)
(receive (parser rec-reader) (let-optionals args ((parser default-field-parser)
(parse-optionals args default-field-parser read-line) (rec-reader read-line))
(lambda maybe-port (lambda maybe-port
(let ((record (apply rec-reader maybe-port))) (let ((record (apply rec-reader maybe-port)))
(if (eof-object? record) (if (eof-object? record)
@ -414,5 +426,3 @@
; (reverse (regexp-reduce string 0 regexp ; (reverse (regexp-reduce string 0 regexp
; (lambda (m ans) (cons (match:substring m 0) ans)) ; (lambda (m ans) (cons (match:substring m 0) ans))
; '()))) ; '())))

38
scsh/rdelim.scm
View File

@ -28,9 +28,8 @@
;;; number of reads, but uses at most double the optimal buffer space. ;;; number of reads, but uses at most double the optimal buffer space.
(define (read-delimited delims . args) (define (read-delimited delims . args)
(receive (port delim-action) (let-optionals args ((port (current-input-port))
(parse-optionals args (current-input-port) 'trim) (delim-action 'trim))
(let ((substr (lambda (s end) ; Smart substring. (let ((substr (lambda (s end) ; Smart substring.
(if (= end (string-length s)) s (if (= end (string-length s)) s
(substring s 0 end)))) (substring s 0 end))))
@ -94,10 +93,10 @@
;;; a following read can pick up the delimiter char. ;;; a following read can pick up the delimiter char.
(define (read-delimited! delims buf . args) ; [port delim-action start end] (define (read-delimited! delims buf . args) ; [port delim-action start end]
(receive (port delim-action start end) (let-optionals args ((port (current-input-port))
(parse-optionals args (current-input-port) 'peek (delim-action 'trim)
0 (string-length buf)) (start 0)
(end (string-length buf)))
(receive (terminator num-read) (receive (terminator num-read)
(%read-delimited! delims buf (%read-delimited! delims buf
(not (eq? delim-action 'peek)) ;Gobble delim? (not (eq? delim-action 'peek)) ;Gobble delim?
@ -108,14 +107,14 @@
end)) end))
(if terminator ; Check for buffer overflow. (if terminator ; Check for buffer overflow.
(let ((retval (if (and (eof-object? terminator) (let ((retval (if (and (zero? num-read)
(zero? num-read)) (eof-object? terminator))
terminator ; EOF -- got nothing. terminator ; EOF -- got nothing.
num-read))) ; Got something. num-read))) ; Got something.
(case delim-action (case delim-action
((split) (values retval terminator))
((peek trim) retval) ((peek trim) retval)
((split) (values retval terminator))
((concat) (cond ((char? terminator) ((concat) (cond ((char? terminator)
(string-set! buf (+ start num-read) terminator) (string-set! buf (+ start num-read) terminator)
(+ num-read 1)) (+ num-read 1))
@ -123,8 +122,8 @@
;; Buffer overflow. ;; Buffer overflow.
(case delim-action (case delim-action
((split) (values #f #f))
((peek trim) #f) ((peek trim) #f)
((split) (values #f #f))
((concat) (let ((last (read-char port))) ((concat) (let ((last (read-char port)))
(if (char? last) (if (char? last)
(string-set! buf (+ start num-read) last)) (string-set! buf (+ start num-read) last))
@ -156,8 +155,9 @@
;;; operation. ;;; operation.
(define (%read-delimited! delims buf gobble? . args) (define (%read-delimited! delims buf gobble? . args)
(receive (port start end) (let-optionals args ((port (current-input-port))
(parse-optionals args (current-input-port) 0 (string-length buf)) (start 0)
(end (string-length buf)))
(check-arg input-port? port %read-delimited!) ; Arg checking. (check-arg input-port? port %read-delimited!) ; Arg checking.
(check-arg char-set? delims %read-delimited!) ; Required, since (check-arg char-set? delims %read-delimited!) ; Required, since
@ -219,7 +219,7 @@
(define (skip-char-set skip-chars . maybe-port) (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))) (cset (->char-set skip-chars)))
(cond ((not (input-port? port)) (cond ((not (input-port? port))
@ -250,10 +250,7 @@
(define charset:newline (char-set #\newline)) (define charset:newline (char-set #\newline))
(define (read-line . rest) (define (read-line . rest) (apply read-delimited charset:newline rest))
(receive (port delim-action)
(parse-optionals rest (current-input-port) 'trim)
(read-delimited charset:newline port delim-action)))
;;; (read-paragraph [port handle-delim]) ;;; (read-paragraph [port handle-delim])
@ -262,9 +259,8 @@
(define blank-line-regexp (make-regexp "^[ \t]*\n$")) (define blank-line-regexp (make-regexp "^[ \t]*\n$"))
(define (read-paragraph . args) (define (read-paragraph . args)
(receive (port handle-delim) (let-optionals args ((port (current-input-port))
(parse-optionals args (current-input-port) 'trim) (handle-delim 'trim))
;; First, skip all blank lines. ;; First, skip all blank lines.
(let lp () (let lp ()
(let ((line (read-line port 'concat))) (let ((line (read-line port 'concat)))