[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