(in-package :pq)

(defun read-quantity (stream char1 char2)
  "The read macro #q(...) is an abbreviation for (quantity ...) which does not transform lowercase symbols to uppercase for unit factors."
  (declare (ignore char2))
  (let (items)
    ;; Read the opening bracket
    (when (char/= (read-char stream) #\()
      (error "Error reading quantity. #~c must be followed by a list." char1))
    ;; Perform minimal parsing of the stream to decide whether or not to perserve the letter case
    (when (char= (peek-char t stream t) #\))
      (error "Error reading quantity: #~c()" char1))
    ;; Read the value of the quantity (do not preserve case)
    (push (read stream t nil t) items)
    ;; Test for the closing bracket
    (unless (char= (peek-char t stream t) #\))
      ;; Read the next symbol (preserve case because it's either the symbol +/- or +- or a unit)
      (let ((*readtable* (copy-readtable *readtable*)))
        (setf (readtable-case *readtable*) :preserve)
        (push (read stream t nil t) items))
      ;; Check whether an uncertainty is specified
      (when (or (eql (first items) '+/-) (eql (first items) '+-))
        ;; Read the uncertainty (do not preserve case)
        (when (char= (peek-char t stream t) #\))
          (error "Error reading quantity #~c(~a ~a): ~a must be followed by an uncertainty/error." char1 (second items) (first items) (first items)))
        (push (read stream t nil t) items))
      ;; Read the rest of the list (preserving case)
      (let ((*readtable* (copy-readtable *readtable*)))
        (setf (readtable-case *readtable*) :preserve)
        (loop until (char= (peek-char t stream t) #\)) do
             (push (read stream t nil t) items))))
    ;; Read the closing bracket
    (read-char stream)
    ;; Expand the list into a macro call
    `(quantity ,@(nreverse items))))

(defun read-unit (stream char1 char2)
  "The read macro #u(...) is an abbreviation for (mkunit ...) which does not transform lowercase symbols to uppercase."
  (declare (ignore char1 char2))
  `(mkunit ,@(let ((*readtable* (copy-readtable *readtable*)))
               ;; Change the readtable such that case is preserved
               (setf (readtable-case *readtable*) :preserve)
               (read stream t nil t))))

(defun define-read-macros (&key (quantity #\q) (unit #\u))
  "Lets the user define the #q(...) and #u(...) read macros."
  (when quantity
    (set-dispatch-macro-character #\# quantity #'read-quantity))
  (when unit
    (set-dispatch-macro-character #\# unit #'read-unit)))
(export 'define-read-macros)

 Read the opening bracket
 Perform minimal parsing of the stream to decide whether or not to perserve the letter case
 Read the value of the quantity (do not preserve case)
 Test for the closing bracket
 Read the next symbol (preserve case because it's either the symbol +/- or +- or a unit)
 Check whether an uncertainty is specified
 Read the uncertainty (do not preserve case)
 Read the rest of the list (preserving case)
 Read the closing bracket
 Expand the list into a macro call
 Change the readtable such that case is preserved
(in-package :pq)

(defun read-quantity (stream char1 char2)
  "The read macro #q(...) is an abbreviation for (quantity ...) which does not transform lowercase symbols to uppercase for unit factors."
  (declare (ignore char2))
  (let (items)
    (when (char/= (read-char stream) #\()
      (error "Error reading quantity. #~c must be followed by a list." char1))
    (when (char= (peek-char t stream t) #\))
      (error "Error reading quantity: #~c()" char1))
    (push (read stream t nil t) items)
    (unless (char= (peek-char t stream t) #\))
      (let ((*readtable* (copy-readtable *readtable*)))
        (setf (readtable-case *readtable*) :preserve)
        (push (read stream t nil t) items))
      (when (or (eql (first items) '+/-) (eql (first items) '+-))
        (when (char= (peek-char t stream t) #\))
          (error "Error reading quantity #~c(~a ~a): ~a must be followed by an uncertainty/error." char1 (second items) (first items) (first items)))
        (push (read stream t nil t) items))
      (let ((*readtable* (copy-readtable *readtable*)))
        (setf (readtable-case *readtable*) :preserve)
        (loop until (char= (peek-char t stream t) #\)) do
             (push (read stream t nil t) items))))
    (read-char stream)
    `(quantity ,@(nreverse items))))

(defun read-unit (stream char1 char2)
  "The read macro #u(...) is an abbreviation for (mkunit ...) which does not transform lowercase symbols to uppercase."
  (declare (ignore char1 char2))
  `(mkunit ,@(let ((*readtable* (copy-readtable *readtable*)))
               (setf (readtable-case *readtable*) :preserve)
               (read stream t nil t))))

(defun define-read-macros (&key (quantity #\q) (unit #\u))
  "Lets the user define the #q(...) and #u(...) read macros."
  (when quantity
    (set-dispatch-macro-character #\# quantity #'read-quantity))
  (when unit
    (set-dispatch-macro-character #\# unit #'read-unit)))
(export 'define-read-macros)
