[gambit-list] fast csv parser (libcsv wrapped for gambit)

Phil Bewig pbewig at gmail.com
Sun Feb 11 19:08:31 EST 2007


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 at 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-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 '()))))
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mailman.iro.umontreal.ca/pipermail/gambit-list/attachments/20070211/24402fae/attachment.htm>


More information about the Gambit-list mailing list