csv: bit faster, simpler.

basis/csv/csv.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2008 Phil Dawes
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences io namespaces make combinators
+USING: combinators fry io io.files io.streams.string kernel
-unicode.categories io.files combinators.short-circuit
+make math memoize namespaces sequences sequences.private
-io.streams.string fry memoize ;
+unicode.categories ;
 IN: csv
 
 SYMBOL: delimiter
@@ -16,56 +16,58 @@ CHAR: , delimiter set-global
 MEMO: (field-end) ( delimiter -- delimiter' )
     "\n" swap suffix ; inline
 
-: field-end ( -- str sep )
-    delimiter> (field-end) read-until ; inline
-
-DEFER: quoted-field
-
 MEMO: (quoted-field) ( delimiter -- delimiter' )
     "\"\n" swap suffix ; inline
 
-: maybe-escaped-quote ( quoted? -- endchar )
+DEFER: quoted-field
-    read1 dup {
-        { CHAR: "    [ over [ , ] [ drop ] if quoted-field ] }
-        { delimiter> [ ] }
-        { CHAR: \n   [ ] } ! Error: newline inside string?
-        [ [ , f maybe-escaped-quote ] when ]
-    } case nip ;
 
-: quoted-field ( -- endchar )
+: maybe-escaped-quote ( delimeter quoted? -- delimiter endchar )
-    "\"" read-until
+    read1 pick over =
-    drop % t maybe-escaped-quote ;
+    [ nip ] [
+        {
+            { CHAR: "    [ [ CHAR: " , ] when quoted-field ] }
+            { CHAR: \n   [ ] } ! Error: newline inside string?
+            [ [ , drop f maybe-escaped-quote ] when* ]
+        } case
+     ] if ;
+
+: quoted-field ( delimiter -- delimiter endchar )
+    "\"" read-until drop % t maybe-escaped-quote ;
 
 : ?trim ( string -- string' )
-    dup { [ first blank? ] [ last blank? ] } 1||
+    dup length [ drop "" ] [
-    [ [ blank? ] trim ] when ;
+        over first-unsafe blank?
+        [ drop t ] [ 1 - over nth-unsafe blank? ] if
+        [ [ blank? ] trim ] when
+    ] if-zero ; inline
 
-: field ( -- sep string )
+: field ( delimiter -- delimiter sep string )
-    delimiter> (quoted-field) read-until
+    dup (quoted-field) read-until
     dup CHAR: " = [
-        over empty?
+        drop
-        [ 2drop [ quoted-field ] "" make ]
+        [ [ quoted-field ] "" make ]
-        [ drop field-end [ "\"" glue ] dip swap ?trim ]
+        [
-        if
+            over (field-end) read-until
-    ] [
+            [ "\"" glue ] dip swap ?trim
-        swap [ "" ] [ ?trim ] if-empty
+        ]
-    ] if ;
+        if-empty
+    ] [ swap ?trim ] if ;
 
-: (row) ( -- sep )
+: (row) ( delimiter -- delimiter sep )
-    f delimiter> '[ dup _ = ]
+    f [ 2dup = ] [ drop field , ] do while ;
-    [ drop field , ] do while ;
 
-: row ( -- eof? array[string] )
+: row ( delimiter -- delimiter eof? array[string] )
     [ (row) ] { } make ;
 
 : (csv) ( -- )
+    delimiter>
     [ dup [ empty? ] all? [ drop ] [ , ] if ]
-    [ row ] do while ;
+    [ row ] do while drop ;
 
 PRIVATE>
 
 : csv-row ( stream -- row )
-    [ row nip ] with-input-stream ;
+    [ delimiter> row 2nip ] with-input-stream ;
 
 : csv ( stream -- rows )
     [ [ (csv) ] { } make ] with-input-stream
@@ -102,16 +104,19 @@ PRIVATE>
     dup needs-escaping?
     [ escape-quotes enclose-in-quotes ] when ; inline
 
+: (write-row) ( row delimiter -- )
+    '[ _ write1 ]
+    [ escape-if-required write ] interleave nl ; inline
+
 PRIVATE>
 
 : write-row ( row -- )
-    delimiter> '[ _ write1 ]
+    delimiter> (write-row) ; inline
-    [ escape-if-required write ] interleave nl ; inline
 
 <PRIVATE
 
 : (write-csv) ( rows -- )
-    [ write-row ] each ;
+    delimiter> '[ _ (write-row) ] each ;
 
 PRIVATE>