csv: some performance improvements.

basis/csv/csv-docs.factor

@@ -2,9 +2,14 @@ USING: help.syntax help.markup kernel prettyprint sequences
 io.pathnames strings ;
 IN: csv
 
-HELP: csv
+HELP: read-row
 { $values { "stream" "an input stream" }
-          { "rows" "an array of arrays of fields" } } 
+          { "row" "an array of fields" } }
+{ $description "parses a row from a csv stream" } ;
+
+HELP: read-csv
+{ $values { "stream" "an input stream" }
+          { "rows" "an array of arrays of fields" } }
 { $description "Parses a csv stream into an array of row arrays." } ;
 
 HELP: file>csv
@@ -35,36 +40,31 @@ HELP: csv>string
 }
 { $description "Writes a comma-separated-value structure to a string." } ;
 
-HELP: csv-row
+HELP: write-row
-{ $values { "stream" "an input stream" }
+{ $values { "row" "an array of fields" } }
-          { "row" "an array of fields" } } 
+{ $description "writes a row to the output stream" } ;
-{ $description "parses a row from a csv stream" } ;
 
 HELP: write-csv
 { $values { "rows" "a sequence of sequences of strings" }
-          { "stream" "an output stream" } } 
+          { "stream" "an output stream" } }
 { $description "Writes a sequence of sequences of comma-separated-values to the output stream, escaping where necessary." } ;
 
 HELP: with-delimiter
-{ $values { "ch" "field delimiter (e.g. CHAR: \t)" }
+{ $values { "ch" "field delimiter (e.g. CHAR: \\t)" }
           { "quot" "a quotation" } }
-{ $description "Sets the field delimiter for csv or csv-row words." } ;
+{ $description "Sets the field delimiter for read-csv, read-row, write-csv, or write-row words." } ;
 
 ARTICLE: "csv" "Comma-separated-values parsing and writing"
 "The " { $vocab-link "csv" } " vocabulary can read and write CSV (comma-separated-value) files." $nl
-"Reading a csv file:"
+"Working with CSV files:"
-{ $subsections file>csv }
+{ $subsections file>csv csv>file }
-"Writing a csv file:"
+"Working with CSV strings:"
-{ $subsections csv>file }
+{ $subsections string>csv csv>string }
-"Reading a string to csv:"
-{ $subsections string>csv }
-"Writing csv to a string:"
-{ $subsections csv>string }
 "Changing the delimiter from a comma:"
 { $subsections with-delimiter }
 "Reading from a stream:"
-{ $subsections csv }
+{ $subsections read-csv read-row }
 "Writing to a stream:"
-{ $subsections write-csv } ;
+{ $subsections write-csv write-row } ;
 
 ABOUT: "csv"

basis/csv/csv.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Phil Dawes
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators fry io io.files io.streams.string kernel
-make math memoize namespaces sequences sequences.private
+make math memoize namespaces sbufs sequences sequences.private
 unicode.categories ;
 IN: csv
 
@@ -13,26 +13,23 @@ CHAR: , delimiter set-global
 
 : delimiter> ( -- delimiter ) delimiter get ; inline
 
-MEMO: (field-end) ( delimiter -- delimiter' )
+MEMO: field-delimiters ( delimiter -- field-end quoted-field )
-    "\n" swap suffix ; inline
+    [ "\n" swap suffix ] [ "\"\n" swap suffix ] bi ; inline
-
-MEMO: (quoted-field) ( delimiter -- delimiter' )
-    "\"\n" swap suffix ; inline
 
 DEFER: quoted-field
 
-: maybe-escaped-quote ( delimeter quoted? -- delimiter endchar )
+: maybe-escaped-quote ( delimeter stream quoted? -- delimiter stream endchar/f )
-    read1 pick over =
+    2over stream-read1 swap over =
     [ nip ] [
         {
             { CHAR: "    [ [ CHAR: " , ] when quoted-field ] }
             { CHAR: \n   [ ] } ! Error: newline inside string?
             [ [ , drop f maybe-escaped-quote ] when* ]
         } case
-     ] if ;
+     ] if ; inline recursive
 
-: quoted-field ( delimiter -- delimiter endchar )
+: quoted-field ( delimiter stream -- delimiter stream endchar/f )
-    "\"" read-until drop % t maybe-escaped-quote ;
+    "\"" over stream-read-until drop % t maybe-escaped-quote ;
 
 : ?trim ( string -- string' )
     dup length [ drop "" ] [
@@ -41,43 +38,44 @@ DEFER: quoted-field
         [ [ blank? ] trim ] when
     ] if-zero ; inline
 
-: field ( delimiter -- delimiter sep string )
+: field ( delimiter stream field-end quoted-field -- delimiter sep/f field )
-    dup (quoted-field) read-until
+    pick stream-read-until dup CHAR: " = [
-    dup CHAR: " = [
         drop
-        [ [ quoted-field ] "" make ]
+        [ drop [ quoted-field nip ] "" make ]
         [
-            over (field-end) read-until
+            swap rot stream-read-until
             [ "\"" glue ] dip swap ?trim
         ]
         if-empty
-    ] [ swap ?trim ] if ;
+    ] [ [ 2drop ] 2dip swap ?trim ] if ;
 
-: (row) ( delimiter -- delimiter sep )
+: (row) ( delimiter stream field-end quoted-field -- delimiter sep/f fields )
-    f [ 2dup = ] [ drop field , ] do while ;
+    [ dup [ 2dup = ] ] 3dip
+    [ [ drop ] 3dip field ] 3curry produce ;
 
-: row ( delimiter -- delimiter eof? array[string] )
+: row ( delimiter -- delimiter sep/f fields )
-    [ (row) ] { } make ;
+    input-stream get over field-delimiters (row) ;
 
 : (csv) ( -- )
     delimiter>
     [ dup [ empty? ] all? [ drop ] [ , ] if ]
-    [ row ] do while drop ;
+    input-stream get pick field-delimiters
+    [ (row) ] 3curry do while drop ;
 
 PRIVATE>
 
-: csv-row ( stream -- row )
+: read-row ( stream -- row )
     [ delimiter> row 2nip ] with-input-stream ;
 
-: csv ( stream -- rows )
+: read-csv ( stream -- rows )
     [ [ (csv) ] { } make ] with-input-stream
     dup last { "" } = [ but-last ] when ;
 
 : string>csv ( string -- csv )
-    <string-reader> csv ;
+    <string-reader> read-csv ;
 
 : file>csv ( path encoding -- csv )
-    <file-reader> csv ;
+    <file-reader> read-csv ;
 
 : with-delimiter ( ch quot -- )
     [ delimiter ] dip with-variable ; inline
@@ -87,34 +85,29 @@ PRIVATE>
 : needs-escaping? ( cell delimiter -- ? )
     '[ dup "\n\"" member? [ drop t ] [ _ = ] if ] any? ; inline
 
-: escape-quotes ( cell -- cell' )
+: escape-quotes ( cell stream -- )
-    [
+    CHAR: " over stream-write1 swap [
-        [
+        [ over stream-write1 ]
-            [ , ]
+        [ dup CHAR: " = [ over stream-write1 ] [ drop ] if ] bi
-            [ dup CHAR: " = [ , ] [ drop ] if ] bi
+    ] each CHAR: " swap stream-write1 ; inline
-        ] each
-    ] "" make ; inline
 
-: enclose-in-quotes ( cell -- cell' )
+: escape-if-required ( cell delimiter stream -- )
-    "\"" dup surround ; inline
+    [ dupd needs-escaping? ] dip
+    [ escape-quotes ] [ stream-write ] bi-curry if ; inline
 
-: escape-if-required ( cell delimiter -- cell' )
+: (write-row) ( row delimiter stream -- )
-    dupd needs-escaping?
+    [ '[ _ _ stream-write1 ] ] 2keep
-    [ escape-quotes enclose-in-quotes ] when ; inline
+    '[ _ _ escape-if-required ] interleave nl ; inline
-
-: (write-row) ( row delimiter -- )
-    dup '[ _ write1 ] swap
-    '[ _ escape-if-required write ] interleave nl ; inline
 
 PRIVATE>
 
 : write-row ( row -- )
-    delimiter> (write-row) ; inline
+    delimiter> output-stream get (write-row) ; inline
 
 <PRIVATE
 
 : (write-csv) ( rows -- )
-    delimiter> '[ _ (write-row) ] each ;
+    delimiter> output-stream get '[ _ _ (write-row) ] each ;
 
 PRIVATE>
 
@@ -124,4 +117,5 @@ PRIVATE>
 : csv>string ( csv -- string )
     [ (write-csv) ] with-string-writer ;
 
-: csv>file ( rows path encoding -- ) <file-writer> write-csv ;
+: csv>file ( rows path encoding -- )
+    <file-writer> write-csv ;