Wow! I'm both impressed and sad. Impressed at the speed-up. Sad that something as simple as read-char can be so slow. And I don't find the fixed-up code nearly as ugly as the C code in libcsv.
Phil
On 2/10/07, Bradley Lucier lucier@math.purdue.edu wrote:
OK, I've done a few experiments. I've added
(declare (standard-bindings)(extended-bindings)(block)(fixnum)(not safe))
to all files.
Here's the original code on my machine, an Opteron running in 64-bit mode, while giving it a 100 MB heap:
(load "bewig")
"/export/users/lucier/lang/scheme/csv/bewig.o7"
(time (begin (read-all (open-input-file "data.csv") read-csv-
record) #t)) (time (begin (read-all (open-input-file "data.csv") read-csv-record) #t)) 591 ms real time 580 ms cpu time (497 user, 83 system) 2 collections accounting for 29 ms real time (25 user, 4 system) 264023440 bytes allocated 25865 minor faults no major faults #t
Next we buffer the collection of characters into a field, (re-)using an extensible string (really ugly code at bottom):
(load "bewig2")
"/export/users/lucier/lang/scheme/csv/bewig2.o17"
(time (begin (read-all (open-input-file "data.csv") read-csv-
record) #t)) (time (begin (read-all (open-input-file "data.csv") read-csv-record) #t)) 436 ms real time 435 ms cpu time (420 user, 15 system) 1 collection accounting for 13 ms real time (13 user, 0 system) 45290944 bytes allocated 3067 minor faults no major faults #t
Next we "simply" use macro-read-char from _io.scm instead of read- char in the original code:
(load "bewig+macro-read-char")
"/export/users/lucier/lang/scheme/csv/bewig+macro-read-char.o2"
(time (begin (read-all (open-input-file "data.csv") read-csv-
record) #t)) (time (begin (read-all (open-input-file "data.csv") read-csv-record) #t)) 175 ms real time 175 ms cpu time (171 user, 4 system) 3 collections accounting for 29 ms real time (29 user, 1 system) 264030352 bytes allocated 376 minor faults no major faults #t
Finally we use macro-read-char in the ugly, buffered-output code:
(load "bewig2+macro-read-char")
"/export/users/lucier/lang/scheme/csv/bewig2+macro-read-char.o2"
(time (begin (read-all (open-input-file "data.csv") read-csv-
record) #t)) (time (begin (read-all (open-input-file "data.csv") read-csv-record) #t)) 105 ms real time 105 ms cpu time (98 user, 7 system) no collections 45270736 bytes allocated 3106 minor faults no major faults #t
So this is over five times as fast as the original code on this test file.
We gain a factor of about three just by inlining the fast path of read-char.
Marc, if you don't want Gambit to suck on simple IO processing like this, you should use the macro-read-char expansion for read-char in the compiler.
Brad
(define (read-csv-record . args)
(define (read-csv sep port)
(define (add-char-to-field c field) (let ((length (field-length field)) (buffer (field-buffer field))) (if (< length (string-length buffer)) (begin (string-set! buffer length c) (field-length-set! field (+ length 1)) field) (let ((new-buffer (string-append buffer (make-string length)))) (string-set! new-buffer length c) (field-length-set! field (+ length 1)) (field-buffer-set! field new-buffer) field)))) (define (extract-string-from-field! field) (let ((result (substring (field-buffer field) 0 (field-lengthfield)))) (reset-field! field) result))
(define (new-field) (cons (make-string 800) 0)) (define (field-buffer field) (car field)) (define (field-buffer-set! field value) (set-car! field value)) (define (field-length field) (cdr field)) (define (field-length-set! field value) (set-cdr! field value)) (define (reset-field! field) (field-length-set! field 0) field) (define (add-field! field fields) (cons (extract-string-from-field! field) fields)) (define (start field fields) (let ((c (read-char port))) (cond ((eof-object? c) (reverse fields)) ((char=? #\return c) (carriage-return field fields)) ((char=? #\newline c) (line-feed field fields)) ((char=? #\" c) (quoted-field field fields)) ((char=? sep c) (let ((fields (add-field! field fields))) (not-field field fields))) (else (unquoted-field (add-char-to-field c field) fields))))) (define (not-field field fields) (let ((c (read-char port))) (cond ((eof-object? c) (cons "" fields)) ((char=? #\return c) (carriage-return '() (add-field! field fields))) ((char=? #\newline c) (line-feed '() (add-field! field fields))) ((char=? #\" c) (quoted-field field fields)) ((char=? sep c) (let ((fields (add-field! field fields))) (not-field field fields))) (else (unquoted-field (add-char-to-field c field) fields))))) (define (quoted-field field fields) (let ((c (read-char port))) (cond ((eof-object? c) (add-field! field fields)) ((char=? #\" c) (may-be-doubled-quotes field fields)) (else (quoted-field (add-char-to-field c field) fields))))) (define (may-be-doubled-quotes field fields) (let ((c (read-char port))) (cond ((eof-object? c) (add-field! field fields)) ((char=? #\return c) (carriage-return '() (add-field! field fields))) ((char=? #\newline c) (line-feed '() (add-field! field fields))) ((char=? #\" c) (quoted-field (add-char-to-field #\" field) fields)) ((char=? sep c) (let ((fields (add-field! field fields))) (not-field field fields))) (else (unquoted-field (add-char-to-field c field) fields))))) (define (unquoted-field field fields) (let ((c (read-char port))) (cond ((eof-object? c) (add-field! field fields)) ((char=? #\return c) (carriage-return '() (add-field! field fields))) ((char=? #\newline c) (line-feed '() (add-field! field fields))) ((char=? sep c) (let ((fields (add-field! field fields))) (not-field field fields)) ) (else (unquoted-field (add-char-to-field c field) fields))))) (define (carriage-return field fields) (if (char=? #\newline (peek-char port)) (read-char port)) fields) (define (line-feed field fields) (if (char=? #\return (peek-char port)) (read-char port)) fields) (if (eof-object? (peek-char port)) (peek-char port) (reverse (start (new-field) '()))))(cond ((null? args) (read-csv #, (current-input-port))) ((and (null? (cdr args)) (char? (car args))) (read-csv (car args) (current-input-port))) ((and (null? (cdr args)) (port? (car args))) (read-csv #, (car args))) ((and (pair? (cdr args)) (null? (cddr args)) (char? (car args)) (port? (cadr args))) (read-csv (car args) (cadr args))) (else (car '()))))