diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2025-01-21 07:24:17 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2025-01-21 07:24:17 -0800 |
commit | 6824735d879f42572778b40c323828f533b87248 (patch) | |
tree | b135841d76b1854936138e348355ae8f93001ee1 /stdlib | |
parent | 519b05f5281572ef9f6f686844af25159ca5896e (diff) | |
download | txr-6824735d879f42572778b40c323828f533b87248.tar.gz txr-6824735d879f42572778b40c323828f533b87248.tar.bz2 txr-6824735d879f42572778b40c323828f533b87248.zip |
New function: get-csv.
* autloload.c (csv_set_entries, csv_instantiate): New
static funtions.
(autoload_init): Register autoload of stdlib/csv
module via new functions.
* stdlib/csv.tl: New file.
* tests/010/csv.tl: Likewise.
* txr.1: Documented.
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/csv.tl | 98 |
1 files changed, 98 insertions, 0 deletions
diff --git a/stdlib/csv.tl b/stdlib/csv.tl new file mode 100644 index 00000000..9b03f3ce --- /dev/null +++ b/stdlib/csv.tl @@ -0,0 +1,98 @@ +;; Copyright 2025 +;; Kaz Kylheku <kaz@kylheku.com> +;; Vancouver, Canada +;; All rights reserved. +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions are met: +;; +;; 1. Redistributions of source code must retain the above copyright notice, +;; this list of conditions and the following disclaimer. +;; +;; 2. Redistributions in binary form must reproduce the above copyright notice, +;; this list of conditions and the following disclaimer in the documentation +;; and/or other materials provided with the distribution. +;; +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +;; POSSIBILITY OF SUCH DAMAGE. + +(defun get-csv (: (stream *stdin*)) + (if (stringp stream) + (upd stream make-string-input-stream)) + (enumlet (rfield qfield cr qcr quot) + (let ((record (vec)) + (field (str 0)) + (state rfield) + (done nil)) + (while (not done) + (let ((ch (get-char stream))) + (caseql* state + (rfield (caseql* ch + (#\return (set state cr)) + (#\newline (vec-push record field) + (set done t)) + (#\, (vec-push record field) + (set field (str 0))) + (#\" (cond + ((empty field) + (set state qfield)) + (t + (string-extend field ch)))) + (nil (vec-push record field) + (set done t)) + (t (string-extend field ch)))) + (qfield (caseql* ch + (#\" (set state quot)) + (#\return (set state qcr)) + (nil (vec-push record field) + (set done t)) + (t (string-extend field ch)))) + (cr (caseql* ch + (#\newline (vec-push record field) + (set done t)) + (#\return (string-extend field ch)) + (#\, (string-extend field #\return) + (vec-push record field) + (set field (str 0) + state rfield)) + (nil (string-extend field #\return) + (vec-push record field) + (set done t)) + (t (string-extend field #\return) + (string-extend field ch) + (set state rfield)))) + (qcr (caseql* ch + (#\newline (string-extend field ch) + (set state qfield)) + (#\return (string-extend field ch)) + (nil (string-extend field #\return) + (vec-push record field) + (set done t)) + (#\" (string-extend field #\return) + (set state quot)) + (t (string-extend field #\return) + (string-extend field ch) + (set state qfield)))) + (quot (caseql* ch + (#\, (vec-push record field) + (set field (str 0) + state rfield)) + (#\" (string-extend field ch) + (set state qfield)) + (#\newline (vec-push record field) + (set done t)) + (#\return (set state cr)) + (nil (vec-push record field) + (set done t)) + (t (string-extend field ch) + (set state rfield))))))) + record))) |