[gambit-list] fast csv parser (libcsv wrapped for gambit)
Bradley Lucier
lucier at math.purdue.edu
Sat Feb 10 11:37:16 EST 2007
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-length
field))))
(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 '()))))
More information about the Gambit-list
mailing list