summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-05-22 13:42:48 +0200
committerAndy Wingo <wingo@pobox.com>2016-05-22 14:52:15 +0200
commita4b06357f644c41188d4e3c555ff60c71631493f (patch)
treee98fa5eba8b0c61a13029ab2398cbc542a24e832
parentfd5e69d3c153c5a023695ecd1452cad865cb3776 (diff)
downloadguile-a4b06357f644c41188d4e3c555ff60c71631493f.tar.gz
Implementation of read-delimited in Scheme
* module/ice-9/sports.scm (port-fold-chars/iso-8859-1): (port-fold-chars, read-delimited, read-line, %read-line): Initial implementation of read-delimited.
-rw-r--r--module/ice-9/sports.scm81
1 files changed, 81 insertions, 0 deletions
diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm
index 3b55e63dd..265b70557 100644
--- a/module/ice-9/sports.scm
+++ b/module/ice-9/sports.scm
@@ -440,6 +440,87 @@
(peek-bytes port 1 fast-path
(lambda (buf bv cur buffered) (slow-path))))
+(define-inlinable (port-fold-chars/iso-8859-1 port proc seed)
+ (let fold-buffer ((buf (port-read-buffer port))
+ (seed seed))
+ (let ((bv (port-buffer-bytevector buf))
+ (end (port-buffer-end buf)))
+ (let fold-chars ((cur (port-buffer-cur buf))
+ (seed seed))
+ (cond
+ ((= end cur)
+ (call-with-values (lambda () (fill-input port))
+ (lambda (buf buffered)
+ (if (zero? buffered)
+ (call-with-values (lambda () (proc the-eof-object seed))
+ (lambda (seed done?)
+ (if done? seed (fold-buffer buf seed))))
+ (fold-buffer buf seed)))))
+ (else
+ (let ((ch (integer->char (bytevector-u8-ref bv cur)))
+ (cur (1+ cur)))
+ (set-port-buffer-cur! buf cur)
+ (port-advance-position! port ch)
+ (call-with-values (lambda () (proc ch seed))
+ (lambda (seed done?)
+ (if done? seed (fold-chars cur seed)))))))))))
+
+(define-inlinable (port-fold-chars port proc seed)
+ (case (%port-encoding port)
+ ((ISO-8859-1) (port-fold-chars/iso-8859-1 port proc seed))
+ (else
+ (let lp ((seed seed))
+ (let ((ch (read-char port)))
+ (call-with-values (lambda () (proc ch seed))
+ (lambda (seed done?)
+ (if done? seed (lp seed)))))))))
+
+(define* (read-delimited delims #:optional (port (current-input-port))
+ (handle-delim 'trim))
+ ;; Currently this function conses characters into a list, then uses
+ ;; reverse-list->string. It wastes 2 words per character but it still
+ ;; seems to be the fastest thing at the moment.
+ (define (finish delim chars)
+ (define (->string chars)
+ (if (and (null? chars) (not (char? delim)))
+ the-eof-object
+ (reverse-list->string chars)))
+ (case handle-delim
+ ((trim) (->string chars))
+ ((split) (cons (->string chars) delim))
+ ((concat)
+ (->string (if (char? delim) (cons delim chars) chars)))
+ ((peek)
+ (when (char? delim) (unread-char delim port))
+ (->string chars))
+ (else
+ (error "unexpected handle-delim value: " handle-delim))))
+ (define-syntax-rule (make-folder delimiter?)
+ (lambda (char chars)
+ (if (or (not (char? char)) (delimiter? char))
+ (values (finish char chars) #t)
+ (values (cons char chars) #f))))
+ (define-syntax-rule (specialized-fold delimiter?)
+ (port-fold-chars port (make-folder delimiter?) '()))
+ (case (string-length delims)
+ ((0) (specialized-fold (lambda (char) #f)))
+ ((1) (let ((delim (string-ref delims 0)))
+ (specialized-fold (lambda (char) (eqv? char delim)))))
+ (else => (lambda (ndelims)
+ (specialized-fold
+ (lambda (char)
+ (let lp ((i 0))
+ (and (< i ndelims)
+ (or (eqv? char (string-ref delims i))
+ (lp (1+ i)))))))))))
+
+(define* (read-line #:optional (port (current-input-port))
+ (handle-delim 'trim))
+ (read-delimited "\n" port handle-delim))
+
+(define* (%read-line port)
+ (read-line port 'split))
+
(define saved-port-bindings #f)
(define port-bindings
'(((guile) read-char peek-char)