Raymond Toy pushed to branch issue-480-double-double-hex-printer at cmucl / cmucl Commits: 014a18a0 by Raymond Toy at 2026-03-10T15:11:21-07:00 Clean up docstrings and update cmucl.pot - - - - - 116c26e9 by Raymond Toy at 2026-03-10T15:11:41-07:00 Add tests for printing double-double special values Make sure double-double-float NaN and infinities are printed in hex format correctly. - - - - - 3 changed files: - src/code/ext-code.lisp - src/i18n/locale/cmucl.pot - tests/extensions.lisp Changes: ===================================== src/code/ext-code.lisp ===================================== @@ -36,7 +36,7 @@ (defun write-hex-float-double (x stream) "Print a single- or double-float in hex format onto STREAM. - Float type and mantissa width are derived from the type of X." + Float type and mantissa width are derived from the type of X." (multiple-value-bind (mantissa-bits suffix-char min-c-exp) (etypecase x (single-float (values (1- (float-digits 1f0)) #\f (- vm:single-float-bias))) @@ -111,9 +111,7 @@ #+double-double (defun write-hex-float-double-double (x stream) - "Print a double-double-float in hex format onto STREAM. - Reconstructs the full significand from hi and lo components - using exact integer arithmetic before formatting." + "Print a double-double-float in hex format onto STREAM." (let* ((hi (kernel:double-double-hi x)) (lo (kernel:double-double-lo x))) ;; Print the sign, but not for NaN since float-sign is unreliable there. @@ -196,7 +194,8 @@ ;;; Writes a float value (single, double, or double-double) in hex ;;; format to a stream, defaulting to *standard-output*. (defun write-hex-float (x &optional (stream *standard-output*)) - "Write float X to STREAM in C-style hex format. STREAM defaults to *standard-output*. + "Write float X to STREAM in C-style hex format. STREAM defaults to + *standard-output*. single-float => 0x<mantissa>p<exp>f double-float => 0x<mantissa>p<exp> @@ -230,10 +229,11 @@ ;;; ;;; Function that can be used in a FORMAT ~/ (defun format-hex-float (stream x colonp atsignp &rest args) - "Format function for use with ~/package:format-hex-float/. + "Format function for use with ~/ext:format-hex-float/. Ignores colon modifier. At-sign modifier forces a leading + sign on - non-negative values. Example: (format t \"~@/ext:format-hex-float/\" - 3.0d0) => +0x1.8p+1" + non-negative values. + + Example: (format t \"~@/ext:format-hex-float/\" 3.0d0) => +0x1.8p+1" (declare (ignore colonp args)) (when (and atsignp (not (float-nan-p x)) @@ -393,8 +393,10 @@ (defun read-hex-float-from-string (s &key (start 0) end) "Read a C-style hex float from string S. START and END bound the region to read (default: entire string). + Signals HEX-FLOAT-PARSE-ERROR on malformed input. + Returns two values: the float and the index of the first character - not consumed. Signals HEX-FLOAT-PARSE-ERROR on malformed input." + not consumed." (with-input-from-string (stream s :start start :end end) (values (read-hex-float-from-stream stream) (file-position stream)))) @@ -403,7 +405,7 @@ ;;; READ-HEX-FLOAT -- Public ;;; ;;; Read a C-style hex float number from either a string or a stream. -(defun ext:read-hex-float (stream-or-string &key (start 0) end) +(defun read-hex-float (stream-or-string &key (start 0) end) "Read a C-style hex float from STREAM-OR-STRING. If a string, START and END bound the region to read. When reading from a string, returns two values: the float and the index of the ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6066,7 +6066,9 @@ msgid "" msgstr "" #: src/code/ext-code.lisp -msgid "Print a single-float or double-float in hex format onto STREAM." +msgid "" +"Print a single- or double-float in hex format onto STREAM.\n" +" Float type and mantissa width are derived from the type of X." msgstr "" #: src/code/ext-code.lisp @@ -6075,8 +6077,8 @@ msgstr "" #: src/code/ext-code.lisp msgid "" -"Write float X to STREAM in C-style hex format. STREAM defaults to *standard-" -"output*.\n" +"Write float X to STREAM in C-style hex format. STREAM defaults to\n" +" *standard-output*.\n" "\n" " single-float => 0x<mantissa>p<exp>f\n" " double-float => 0x<mantissa>p<exp>\n" @@ -6095,10 +6097,11 @@ msgstr "" #: src/code/ext-code.lisp msgid "" -"Format function for use with ~/package:format-hex-float/.\n" +"Format function for use with ~/ext:format-hex-float/.\n" " Ignores colon modifier. At-sign modifier forces a leading + sign on\n" -" non-negative values. Example: (format t \"~@/ext:format-hex-float/\"\n" -" 3.0d0) => +0x1.8p+1" +" non-negative values.\n" +"\n" +" Example: (format t \"~@/ext:format-hex-float/\" 3.0d0) => +0x1.8p+1" msgstr "" #: src/code/ext-code.lisp @@ -6120,8 +6123,10 @@ msgstr "" msgid "" "Read a C-style hex float from string S.\n" " START and END bound the region to read (default: entire string).\n" +" Signals HEX-FLOAT-PARSE-ERROR on malformed input.\n" +"\n" " Returns two values: the float and the index of the first character\n" -" not consumed. Signals HEX-FLOAT-PARSE-ERROR on malformed input." +" not consumed." msgstr "" #: src/code/ext-code.lisp ===================================== tests/extensions.lisp ===================================== @@ -84,6 +84,17 @@ (assert-equal "0x1.fffffffffffff8p-1w" (ext:float-to-hex-string (- 1.0w0 (scale-float 1.0w0 -54))))) +(define-test write-double-double-special + (assert-equal "0x1.0p+infw" + (ext:float-to-hex-string (float ext:double-float-positive-infinity 1w0))) + (assert-equal "-0x1.0p+infw" + (ext:float-to-hex-string (float ext:double-float-negative-infinity 1w0))) + (assert-equal "0x0.0p+nanw" + (ext:float-to-hex-string + (ext:with-float-traps-masked (:invalid) + (- (float ext:double-float-positive-infinity 1w0) + (float ext:double-float-positive-infinity 1w0)))))) + ;;; ---- read-hex-float tests ------------------------------------------------ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a15d70c535d7959d2ba2c72... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a15d70c535d7959d2ba2c72... You're receiving this email because of your account on gitlab.common-lisp.net.