(defun force-json-number-syntax (string &optional start end)
  "This repairs broken Lisp printers. `string` is supposed to be what
PRIN1 yielded for printing a floating point number.

We take the string apart into a sign, an integral part, an optional
fractional part, an optional exponent part and construct a new
string. There will be no leading plus sign, no leading zeros (unless
the integral part is zero), at least one digit before and after the
decimal point, #\E for the exponent marker."
  (setq start (or start 0) end (or end (length string)))
  (let ((p start)
        negativep
        int.s int.e
        frac.s frac.e
        exp.s exp.e)
    (when (< p end)
      (case (char string p)
        (#\- (setq negativep t p (+ p 1)))
        (#\+ (incf p))))
    (loop while (and (< p end) (char= #\0 (char string p))) do (incf p))
    (when (and (< p end) (char<= #\1 (char string p) #\9))
      (setq int.s p)
      (loop while (and (< p end) (char<= #\0 (char string p) #\9)) do (incf p))
      (setq int.e p))
    (when (and (< p end) (char= #\. (char string p)))
      (incf p)
      (when (and (< p end) (char<= #\0 (char string p) #\9))
        (setq frac.s p)
        (loop while (and (< p end) (char<= #\0 (char string p) #\9)) do (incf p))
        (setq frac.e p)))
    (when (and (< p end) (alpha-char-p (char string p)))
      (let ((p2 (1+ p)))
        (when (and (< p2 end) (find (char string p2) "+-"))
          (incf p2))
        (when (and (< p2 end) (char<= #\0 (char string p2) #\9))
          (setq exp.s (1+ p))
          (loop while (and (< p2 end) (char<= #\0 (char string p2) #\9)) do (incf p2))
          (setq exp.e p2 p p2))))
    (and (= p end)
         (concatenate 'string
                      (if negativep "-" "")
                      (if int.s (subseq string int.s int.e) "0")
                      "."
                      (if frac.s (subseq string frac.s frac.e) "0")
                      (if exp.s "E" "")
                      (if exp.s (subseq string exp.s exp.e) "")))))