(defpackage :csv
  (:use :common-lisp))

(in-package :csv)

(defun read-csv (stream)
  (let* ((minimum-room 4096)
         (buffer (if (stringp stream)
                     stream
                     (make-array (* 2 minimum-room) :element-type 'character)))
         (start 0)                      ;start of our current field
         ;; fill pointer of buffer
         (fptr (if (stringp stream) (length stream) 0))
         (p 0)                          ;reading pointer
         row
         rows)
    (declare (type (simple-array character (*)))
             (type fixnum start fptr p)
             (optimize (speed 3) (safety 0)))
    (labels ((underflow ()
               (replace buffer buffer :start2 start :end2 p)
               (decf p start)
               (decf start start)
               (when (<= (- (length buffer) start) minimum-room)
                 (setq buffer (adjust-array buffer (+ (length buffer) minimum-room)))
                 (setq minimum-room (* minimum-room 2)))
               (setf fptr (if (stringp stream) p (read-sequence buffer stream :start p))))
             (add-field (buffer start end)
               (push (subseq buffer start end) row))
             (add-row ()
               (push (reverse row) rows)
               (setq row nil)))
      (declare (inline underflow))
      (setq start 0)
      (loop
        (when (= p fptr) (underflow))
        (when (= p fptr)
          (when (or (> p start) row)
            (add-field buffer start p)
            (add-row))
          (return))
        (let ((c (char buffer p)))
          (incf p)
          (case c
            (#\,
             (add-field buffer start (1- p))
             (setq start p))
            (#\newline
             (add-field buffer start (1- p))
             (add-row)
             (setq start p)) )))
      (reverse rows))))