[Guile-commits] 06/06: Implement read-char in Scheme.

[Andy Wingo]

wingo pushed a commit to branch wip-port-refactor
in repository guile.

commit d28d1a57bf0ff50b4292a64bc4146f9a9488c3d5
Author: Andy Wingo <address@hidden>
Date:   Tue May 10 15:38:30 2016 +0200

    Implement read-char in Scheme.
    
    * module/ice-9/ports.scm (%read-char): New function.
---
 module/ice-9/ports.scm |   45 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 45 insertions(+)

diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index cdfd011..43283e7 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -467,6 +467,51 @@ interpret its input and output."
   (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)
+    (case char
+      ((#\alarm) #t) ; No change.
+      ((#\backspace)
+       (let ((col (port-column port)))
+         (when (> col 0)
+           (set-port-column! port (1- col)))))
+      ((#\newline)
+       (set-port-line! port (1+ (port-line port)))
+       (set-port-column! port 0))
+      ((#\return)
+       (set-port-column! port 0))
+      ((#\tab)
+       (let ((col (port-column port)))
+         (set-port-column! port (- (+ col 8) (remainder col 8)))))
+      (else
+       (set-port-column! port (1+ (port-column port)))))
+    char)
+  (define (slow-path)
+    (call-with-values (lambda () (peek-char-and-len port))
+      (lambda (char len)
+        (let ((buf (port-read-buffer port)))
+          (set-port-buffer-cur! buf (+ (port-buffer-cur buf) len))
+          (if (eq? char the-eof-object)
+              (set-port-buffer-has-eof?! buf #f)
+              (update-position! char))
+          char))))
+  (define (fast-path buf bv cur buffered)
+    (let ((u8 (bytevector-u8-ref bv cur))
+          (enc (%port-encoding port)))
+      (case enc
+        ((UTF-8)
+         (decode-utf8 bv cur buffered u8
+                      (lambda (char len)
+                        (set-port-buffer-cur! buf (+ cur len))
+                        (update-position! char))
+                      slow-path))
+        ((ISO-8859-1)
+         (set-port-buffer-cur! buf (+ cur 1))
+         (update-position! (integer->char u8)))
+        (else (slow-path)))))
+  (peek-bytes port 1 fast-path
+              (lambda (buf bv cur buffered) (slow-path))))
+
 
 
 ;;; Current ports as parameters.