From 91b1f3fff17498e3234ca2adb6b73d074874c6f4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 14 Mar 2013 21:05:41 -0700 Subject: [PATCH] csv: some performance improvements. --- basis/csv/csv-docs.factor | 38 +++++++++--------- basis/csv/csv.factor | 84 ++++++++++++++++++--------------------- 2 files changed, 58 insertions(+), 64 deletions(-) diff --git a/basis/csv/csv-docs.factor b/basis/csv/csv-docs.factor index 32c4cd53fb..056fdfb393 100644 --- a/basis/csv/csv-docs.factor +++ b/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 -{ $values { "stream" "an input stream" } - { "row" "an array of fields" } } -{ $description "parses a row from a csv stream" } ; +HELP: write-row +{ $values { "row" "an array of fields" } } +{ $description "writes a row to the output 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:" -{ $subsections file>csv } -"Writing a csv file:" -{ $subsections csv>file } -"Reading a string to csv:" -{ $subsections string>csv } -"Writing csv to a string:" -{ $subsections csv>string } +"Working with CSV files:" +{ $subsections file>csv csv>file } +"Working with CSV strings:" +{ $subsections string>csv 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" diff --git a/basis/csv/csv.factor b/basis/csv/csv.factor index 2359c89a20..c46a1e08a3 100644 --- a/basis/csv/csv.factor +++ b/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' ) - "\n" swap suffix ; inline - -MEMO: (quoted-field) ( delimiter -- delimiter' ) - "\"\n" swap suffix ; inline +MEMO: field-delimiters ( delimiter -- field-end quoted-field ) + [ "\n" swap suffix ] [ "\"\n" swap suffix ] bi ; inline DEFER: quoted-field -: maybe-escaped-quote ( delimeter quoted? -- delimiter endchar ) - read1 pick over = +: maybe-escaped-quote ( delimeter stream quoted? -- delimiter stream endchar/f ) + 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 ) - "\"" read-until drop % t maybe-escaped-quote ; +: quoted-field ( delimiter stream -- delimiter stream endchar/f ) + "\"" 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 ) - dup (quoted-field) read-until - dup CHAR: " = [ +: field ( delimiter stream field-end quoted-field -- delimiter sep/f field ) + pick stream-read-until 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 ) - f [ 2dup = ] [ drop field , ] do while ; +: (row) ( delimiter stream field-end quoted-field -- delimiter sep/f fields ) + [ dup [ 2dup = ] ] 3dip + [ [ drop ] 3dip field ] 3curry produce ; -: row ( delimiter -- delimiter eof? array[string] ) - [ (row) ] { } make ; +: row ( delimiter -- delimiter sep/f fields ) + 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 ) - csv ; + read-csv ; : file>csv ( path encoding -- csv ) - csv ; + 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' ) - [ - [ - [ , ] - [ dup CHAR: " = [ , ] [ drop ] if ] bi - ] each - ] "" make ; inline +: escape-quotes ( cell stream -- ) + CHAR: " over stream-write1 swap [ + [ over stream-write1 ] + [ dup CHAR: " = [ over stream-write1 ] [ drop ] if ] bi + ] each CHAR: " swap stream-write1 ; inline -: enclose-in-quotes ( cell -- cell' ) - "\"" dup surround ; inline +: escape-if-required ( cell delimiter stream -- ) + [ dupd needs-escaping? ] dip + [ escape-quotes ] [ stream-write ] bi-curry if ; inline -: escape-if-required ( cell delimiter -- cell' ) - dupd needs-escaping? - [ escape-quotes enclose-in-quotes ] when ; inline - -: (write-row) ( row delimiter -- ) - dup '[ _ write1 ] swap - '[ _ escape-if-required write ] interleave nl ; inline +: (write-row) ( row delimiter stream -- ) + [ '[ _ _ stream-write1 ] ] 2keep + '[ _ _ escape-if-required ] interleave nl ; inline PRIVATE> : write-row ( row -- ) - delimiter> (write-row) ; inline + delimiter> output-stream get (write-row) ; inline '[ _ (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 -- ) write-csv ; +: csv>file ( rows path encoding -- ) + write-csv ;