diff options
author | Andy Wingo <wingo@pobox.com> | 2016-05-22 18:16:19 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-05-22 18:16:19 +0200 |
commit | fd17cf9f72bcfc1832775c848e678e695d05dbd8 (patch) | |
tree | e5e5decb36b46cfa5e436bfb8882b2de9fd5bf91 /module | |
parent | a4b06357f644c41188d4e3c555ff60c71631493f (diff) | |
download | guile-fd17cf9f72bcfc1832775c848e678e695d05dbd8.tar.gz |
Speed up port position access from Scheme
* libguile/ports-internal.h (scm_port_buffer_position):
(scm_port_position_line, scm_port_position_set_line):
(scm_port_position_column, scm_port_position_set_column): New
helpers.
(scm_t_port): Ports now hold position as a pair, so that Scheme can
access it easily.
(SCM_LINUM, SCM_COL, SCM_INCLINE, SCM_ZEROCOL, SCM_INCCOL)
(SCM_DECCOL, SCM_TABCOL): Remove.
* libguile/ports.c (make_port_buffer): Rename from
scm_c_make_port_buffer, make static, and take port as an argument so
we can initialize the position field.
(initialize_port_buffers): Adapt make_port_buffer change.
(scm_c_make_port_with_encoding): Initialize position.
(update_port_position): Rename from update_port_lf, and operate on
port position objects.
(scm_ungetc): Operate on port position objects.
(scm_setvbuf, scm_expand_port_read_buffer_x): Adapt to
make_port_buffer change.
(scm_lfwrite): Adapt to call update_port_position.
(scm_port_line, scm_set_port_line_x, scm_port_column)
(scm_set_port_column_x): Adapt to use port positions.
* libguile/ports.h (scm_c_make_port_buffer): Remove internal decl.
* libguile/read.c: Adapt to use scm_port_line / scm_port_column instead
of SCM_LINUM et al.
* module/ice-9/ports.scm (port-buffer-position, port-position-line)
(port-position-column, set-port-position-line!)
(set-port-position-column!): New accessors for the internals module.
* module/ice-9/sports.scm (advance-port-position!): Rename from
port-advance-position! and use the new accessors.
(read-char, port-fold-chars/iso-8859-1): Adapt to use
advance-port-position!.
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/ports.scm | 15 | ||||
-rw-r--r-- | module/ice-9/sports.scm | 32 |
2 files changed, 31 insertions, 16 deletions
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm index 4330ebedf..4b7462585 100644 --- a/module/ice-9/ports.scm +++ b/module/ice-9/ports.scm @@ -169,9 +169,14 @@ interpret its input and output." port-buffer-cur port-buffer-end port-buffer-has-eof? + port-buffer-position set-port-buffer-cur! set-port-buffer-end! set-port-buffer-has-eof?! + port-position-line + port-position-column + set-port-position-line! + set-port-position-column! port-read port-write port-clear-stream-start-for-bom-read @@ -188,6 +193,7 @@ interpret its input and output." (define-syntax-rule (port-buffer-cur buf) (vector-ref buf 1)) (define-syntax-rule (port-buffer-end buf) (vector-ref buf 2)) (define-syntax-rule (port-buffer-has-eof? buf) (vector-ref buf 3)) +(define-syntax-rule (port-buffer-position buf) (vector-ref buf 4)) (define-syntax-rule (set-port-buffer-cur! buf cur) (vector-set! buf 1 cur)) @@ -196,6 +202,15 @@ interpret its input and output." (define-syntax-rule (set-port-buffer-has-eof?! buf has-eof?) (vector-set! buf 3 has-eof?)) +(define-syntax-rule (port-position-line position) + (car position)) +(define-syntax-rule (port-position-column position) + (cdr position)) +(define-syntax-rule (set-port-position-line! position line) + (set-car! position line)) +(define-syntax-rule (set-port-position-column! position column) + (set-cdr! position column)) + (eval-when (expand) (define-syntax-rule (private-port-bindings binding ...) (begin diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm index 265b70557..2ee97340b 100644 --- a/module/ice-9/sports.scm +++ b/module/ice-9/sports.scm @@ -384,34 +384,34 @@ (peek-bytes port 1 fast-path (lambda (buf bv cur buffered) (slow-path)))) -(define-inlinable (port-advance-position! port char) +(define-inlinable (advance-port-position! pos 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)))) + (set-port-position-column! pos (1+ (port-position-column pos)))) (else (case char ((#\alarm) #t) ; No change. ((#\backspace) - (let ((col (port-column port))) + (let ((col (port-position-column pos))) (when (> col 0) - (set-port-column! port (1- col))))) + (set-port-position-column! pos (1- col))))) ((#\newline) - (set-port-line! port (1+ (port-line port))) - (set-port-column! port 0)) + (set-port-position-line! pos (1+ (port-position-line pos))) + (set-port-position-column! pos 0)) ((#\return) - (set-port-column! port 0)) + (set-port-position-column! pos 0)) ((#\tab) - (let ((col (port-column port))) - (set-port-column! port (- (+ col 8) (remainder col 8))))) + (let ((col (port-position-column pos))) + (set-port-position-column! pos (- (+ col 8) (remainder col 8))))) (else - (set-port-column! port (1+ (port-column port)))))))) + (set-port-position-column! pos (1+ (port-position-column pos)))))))) (define* (read-char #:optional (port (current-input-port))) - (define (finish char) - (port-advance-position! port char) + (define (finish buf char) + (advance-port-position! (port-buffer-position buf) char) char) (define (slow-path) (call-with-values (lambda () (peek-char-and-len port)) @@ -422,7 +422,7 @@ (begin (set-port-buffer-has-eof?! buf #f) char) - (finish char)))))) + (finish buf char)))))) (define (fast-path buf bv cur buffered) (let ((u8 (bytevector-u8-ref bv cur)) (enc (%port-encoding port))) @@ -431,11 +431,11 @@ (decode-utf8 bv cur buffered u8 (lambda (char len) (set-port-buffer-cur! buf (+ cur len)) - (finish char)) + (finish buf char)) slow-path)) ((ISO-8859-1) (set-port-buffer-cur! buf (+ cur 1)) - (finish (integer->char u8))) + (finish buf (integer->char u8))) (else (slow-path))))) (peek-bytes port 1 fast-path (lambda (buf bv cur buffered) (slow-path)))) @@ -460,7 +460,7 @@ (let ((ch (integer->char (bytevector-u8-ref bv cur))) (cur (1+ cur))) (set-port-buffer-cur! buf cur) - (port-advance-position! port ch) + (advance-port-position! (port-buffer-position buf) ch) (call-with-values (lambda () (proc ch seed)) (lambda (seed done?) (if done? seed (fold-chars cur seed))))))))))) |