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)
(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))
; '())))

38
scsh/rdelim.scm
View File

@ -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)))