-

-#+nil

-(defun reshape-fixed (raw-digits exponent)

-  ;; RAW-DIGITS is a string of digits with no sign or decimal point.

-  (declare (simple-string raw-digits)

-	   (fixnu exponent))

-  (let* ((digit-count (length raw-digits))

-	 (left-count (1+ exponent)))

-    (cond ((>= left-count digit-count)

-	   ;; All digits go in the integer part; pad with trailing

-	   ;; zeros

-	   (concatenate 'string

-			raw-digits

-			(make-string (- left-count digit-count)

-				     :initial-element #\0)

-			".0"))

-	  ((plusp left-count)

-	   (concatenate 'string

-			(subseq raw-digits 0 left-count)

-			"."

-			(subseq raw-digits left-count)))

-	  (t

-	   ;; All digits go in the fractional part; prepend "0." and

-	   ;; any needed leading zeroes.

-	   (concatenate 'string

-			"0."

-			(make-string (- left-count) :initial-element #\0)

-			raw-digits)))))

-

-#+nil

-(defun reshape-fixed (raw-digits exponent)

-  ;; RAW-DIGITS is a string of digits with no sign or decimal point.

-  (declare (simple-string raw-digits)

-	   (fixnum exponent))

-  (let* ((digit-count (length raw-digits))

-	 (left-count (1+ exponent)))

-    (with-output-to-string (s)

-      (cond ((>= left-count digit-count)

-	     ;; All digits go in the integer part; pad with trailing

-	     ;; zeros

-	     (write-string raw-digits s)

-	     (loop for k from 0 below (- left-count digit-count)

-		   do (write-char #\0 s))

-	     (write-string ".0" s))

-	    ((plusp left-count)

-	     (write-string raw-digits s :start 0 :end left-count)

-	     (write-char #\. s)

-	     (write-string raw-digits s :start left-count))

-	    (t

-	     ;; All digits go in the fractional part; prepend "0." and

-	     ;; any needed leading zeroes.

-	     (write-string "0." s)

-	     (loop for k from 0 below (- left-count)

-		   do (write-char #\0 s))

-	     (write-string raw-digits s))))))

-

-#+nil

-(defun reshape-fixed (mantissa-text exponent)

-  (declare (type simple-string mantissa-text)

-	   (fixnum exponent))

-  (reshape-format-e mantissa-text (1+ exponent) nil))

-

-#+nil

-(defun reshape-fixed (stream mantissa-text exponent)

-  "Adjust MANTISSA-TEXT is scaled exactly by 10^{EXPONENT} by moving the

-  decimal point.  MANTISSA-TEXT is of the form 'd[.dddd]' from d2exp

-  or d2s.  The scaled value is written to STREAM."

-  (declare (type simple-string mantissa-text)

-	   (fixnum exponent))

-  (let ((k (1+ exponent)))

-    ;; If exponent = 0, the mantissa is already the right value, but

-    ;; we need to append ".0" if there's not dot in the mantissa.

-    ;; This happens when d2s is given a small exact integral value.

-    (when (zerop exponent)

-      (write-string mantissa-text stream)

-      (unless (find #\. mantissa-text)

-	(write-string ".0" stream))

-      (return-from reshape-fixed))

-  (let* ((has-dot     (find #\. mantissa-text))

-         (lead-char   (char mantissa-text 0))

-	 ;; Where the stuff after the dot starts

-         (tail-start  (if has-dot 2 1))

-         (tail-len    (- (length mantissa-text) tail-start))

-         (digit-count (1+ tail-len)))

-    ;; Several cases to consider:

-    ;;

-    ;; * k is negative so the new dot preceeds the mantissa.  Pad with

-    ;;   zeroes.

-    ;; * k is so large that the dot is past the rightmost part of the

-    ;;   mantissa.  Append enough zeroes and then add ".0"

-    ;; * k is somewhere in the mantissa.  Handling of this case

-    ;;   depends on if the new dot is to the left or to the right of

-    ;;   the original dot.

-    (cond

-      ;; Case 2: new dot at or before position 0.

-      ((<= k 0)

-       (write-string "0." stream)

-       ;; Insert zeros after the decimal but before the mantissa.

-       (loop repeat (- k)

-	     do (write-char #\0 stream))

-       ;; Insert the mantissa, skipping the existing dot.

-       (write-char lead-char stream)

-       (when (plusp tail-len)

-         (write-string mantissa-text stream :start tail-start)))

-      ;; Case 1b: 1 < k < digit-count.  Move dot right by (k-1).

-      ((< k digit-count)

-       ;; Output the original mantissa up to the original dot.

-       (write-char lead-char stream)

-       (write-string mantissa-text stream

-                     :start tail-start

-                     :end (+ tail-start k -1))

-       ;; Output the new dot.

-       (write-char #\. stream)

-       ;; Output everything after the original dot.

-       (write-string mantissa-text stream

-		     :start (+ tail-start k -1)))

-      ;; Case 3: k >= digit-count.  Pad with zeros, force ".0".

-      (t

-       ;; Output the original mantissa, then everything after the

-       ;; dot (if there was one).

-       (write-char lead-char stream)

-       (when (plusp tail-len)

-         (write-string mantissa-text stream :start tail-start))

-       ;; Pad with 0's

-       (loop repeat (- k digit-count)

-	     do (write-char #\0 stream))

-       ;; Finish with ".0".

-       (write-string ".0" stream))))))

-

-#+nil

-(defun emit-shortest (mantissa-text exponent is-negative-p w overflowchar padchar at-sign-p)

-  (let* ((reshaped (reshape-fixed mantissa-text exponent))

-	 (sign-text (cond (is-negative-p "-")

-			  (at-sign-p "+")

-			  (t "")))

-	 (field (concatenate 'string sign-text reshaped)))

-    (format-f-pad-overflow field w overflowchar padchar)))

-