[pg-devel] [PATCH] CLSQL support, more encodings, float parser, etc

[Vladimir Sekissov]

Good day,

eric.marsden> CL-USER> (float-parser ".1347626e3")
eric.marsden> 134.76260000000002d0
eric.marsden>   
eric.marsden>   The current float parser (using READ-FROM-STRING) does
eric.marsden> respect this.

Here is READ-FROM-STRING compatible version:

CL-USER> (pg::float-parser ".1347626e3")
134.7626

CL-USER> (read-from-string ".1347626e3")
134.7626
10

CL-USER> (let ((*read-default-float-format* 'double-float))
            (pg::float-parser ".1347626e3"))
134.76260000000002d0

CL-USER> (let ((*read-default-float-format* 'double-float))
            (read-from-string ".1347626e3"))
134.7626d0
10

(defun float-parser (str)
  (declare (type simple-string str))

  (let ((idx 0)
        (str-len (length str)))
    (labels ((nxt-char ()
               (when (< idx str-len)
                 (prog1 (char str idx)
                   (incf idx))))
             (cur-char ()
               (when (< idx str-len)
                 (char str idx)))
             (read-integer ()
               (multiple-value-bind (int int-idx)
                   (parse-integer str :start idx :junk-allowed t)
                 (multiple-value-prog1 (values int (- int-idx idx))
                   (setf idx int-idx))))
             (read-sign ()
               (case (cur-char)
                 (#\- (nxt-char)
                      -1)
                 (#\+ (nxt-char)
                      1)
                 (otherwise 1)))
             (read-fractional-part ()
               (case (cur-char)
                 (#\. (nxt-char)
                      (multiple-value-bind (int count)
                          (read-integer)
                        (when int
                          (* int (expt 10 (- count))))))
                 (otherwise nil)))
             (read-exponent ()
               (case (cur-char)
                 ((#\e #\E) (nxt-char)
                  (read-integer))
                 (otherwise 0))))
      (let ((sign (read-sign))
            (int-part (read-integer))
            (fractional-part (read-fractional-part))
            (exponent (read-exponent)))

        (unless (and (or int-part fractional-part)
                     (= idx str-len))
          (error "Unknown float format or not a float ~a" str))

        (unless int-part
          (setf int-part 0))
        (* (+ (coerce int-part *read-default-float-format*)
              (or fractional-part 0))
           (expt 10 exponent)
           sign)))))

Best Regards,
Vladimir Sekissov