 MEMO: (field-end) ( delimiter -- delimiter' )
     "\n" swap suffix ; inline
 
-: field-end ( -- str sep )
-    delimiter> (field-end) read-until ; inline
+MEMO: (quoted-field) ( delimiter -- delimiter' )
+    "\"\n" swap suffix ; inline
 
 DEFER: quoted-field
 
-MEMO: (quoted-field) ( delimiter -- delimiter' )
-    "\"\n" swap suffix ; inline
+: maybe-escaped-quote ( delimeter quoted? -- delimiter endchar )
+    read1 pick over =
+    [ nip ] [
+        {
+            { CHAR: "    [ [ CHAR: " , ] when quoted-field ] }
+            { CHAR: \n   [ ] } ! Error: newline inside string?
+            [ [ , drop f maybe-escaped-quote ] when* ]
+        } case
+     ] if ;
 
-: maybe-escaped-quote ( quoted? -- endchar )
-    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 )
-    "\"" read-until
-    drop % t maybe-escaped-quote ;
+: quoted-field ( delimiter -- delimiter endchar )
+    "\"" read-until drop % t maybe-escaped-quote ;
 
 : ?trim ( string -- string' )
-    dup { [ first blank? ] [ last blank? ] } 1||
-    [ [ blank? ] trim ] when ;
+    dup length [ drop "" ] [
+        over first-unsafe blank?
+        [ drop t ] [ 1 - over nth-unsafe blank? ] if
+        [ [ blank? ] trim ] when
+    ] if-zero ; inline
 
-: field ( -- sep string )
-    delimiter> (quoted-field) read-until
+: field ( delimiter -- delimiter sep string )
+    dup (quoted-field) read-until
     dup CHAR: " = [
-        over empty?
-        [ 2drop [ quoted-field ] "" make ]
-        [ drop field-end [ "\"" glue ] dip swap ?trim ]
-        if
-    ] [
-        swap [ "" ] [ ?trim ] if-empty
-    ] if ;
+        drop
+        [ [ quoted-field ] "" make ]
+        [
+            over (field-end) read-until
+            [ "\"" glue ] dip swap ?trim
+        ]
+        if-empty
+    ] [ swap ?trim ] if ;
 
-: (row) ( -- sep )
-    f delimiter> '[ dup _ = ]
-    [ drop field , ] do while ;
+: (row) ( delimiter -- delimiter sep )
+    f [ 2dup = ] [ 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

    dup needs-escaping?
    [ escape-quotes enclose-in-quotes ] when ; inline

PRIVATE>

: write-row ( row -- )
    delimiter> '[ _ write1 ]
    [ escape-if-required write ] interleave nl ; inline

<PRIVATE

: (write-csv) ( rows -- )
    [ write-row ] each ;

PRIVATE>


! 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
unicode.categories ;
IN: csv

SYMBOL: delimiter
