summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-05-22 13:42:00 +0200
committerAndy Wingo <wingo@pobox.com>2016-05-22 13:42:00 +0200
commitfd5e69d3c153c5a023695ecd1452cad865cb3776 (patch)
tree21f8d350c160d4cfefcd65050901f2229ea7fd47
parent1852633a9bf449e4a2399de969db70a0d095a5ea (diff)
downloadguile-fd5e69d3c153c5a023695ecd1452cad865cb3776.tar.gz
Sports refactor
* module/ice-9/sports.scm (port-advance-position!): Factor out to a helper. (read-char): Use port-advance-position!.
-rw-r--r--module/ice-9/sports.scm24
1 files changed, 17 insertions, 7 deletions
diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm
index 91e51e37a..3b55e63dd 100644
--- a/module/ice-9/sports.scm
+++ b/module/ice-9/sports.scm
@@ -384,10 +384,16 @@
(peek-bytes port 1 fast-path
(lambda (buf bv cur buffered) (slow-path))))
-(define* (read-char #:optional (port (current-input-port)))
- (define (update-position! char)
+(define-inlinable (port-advance-position! port char)
+ ;; FIXME: this cond is a speed hack; really we should just compile
+ ;; `case' better.
+ (cond
+ ;; FIXME: char>? et al should compile well.
+ ((<= (char->integer #\space) (char->integer char))
+ (set-port-column! port (1+ (port-column port))))
+ (else
(case char
- ((#\alarm) #t) ; No change.
+ ((#\alarm) #t) ; No change.
((#\backspace)
(let ((col (port-column port)))
(when (> col 0)
@@ -401,7 +407,11 @@
(let ((col (port-column port)))
(set-port-column! port (- (+ col 8) (remainder col 8)))))
(else
- (set-port-column! port (1+ (port-column port)))))
+ (set-port-column! port (1+ (port-column port))))))))
+
+(define* (read-char #:optional (port (current-input-port)))
+ (define (finish char)
+ (port-advance-position! port char)
char)
(define (slow-path)
(call-with-values (lambda () (peek-char-and-len port))
@@ -412,7 +422,7 @@
(begin
(set-port-buffer-has-eof?! buf #f)
char)
- (update-position! char))))))
+ (finish char))))))
(define (fast-path buf bv cur buffered)
(let ((u8 (bytevector-u8-ref bv cur))
(enc (%port-encoding port)))
@@ -421,11 +431,11 @@
(decode-utf8 bv cur buffered u8
(lambda (char len)
(set-port-buffer-cur! buf (+ cur len))
- (update-position! char))
+ (finish char))
slow-path))
((ISO-8859-1)
(set-port-buffer-cur! buf (+ cur 1))
- (update-position! (integer->char u8)))
+ (finish (integer->char u8)))
(else (slow-path)))))
(peek-bytes port 1 fast-path
(lambda (buf bv cur buffered) (slow-path))))