diff options
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))) |