| ... |
... |
@@ -851,6 +851,56 @@ |
|
851
|
851
|
(format s "Hex float parse error in ~S: ~A"
|
|
852
|
852
|
(hex-parse-error-text c) (hex-parse-error-message c)))))
|
|
853
|
853
|
|
|
|
854
|
+(defun parse-hex-float (str)
|
|
|
855
|
+ "Parses C-style hex strings by converting to an exact rational, then to double-float."
|
|
|
856
|
+ (let* ((str (string-trim '(#\Space #\Tab #\Newline #\Return) (string-downcase str)))
|
|
|
857
|
+ (len (length str)))
|
|
|
858
|
+ (when (zerop len) (error 'hex-parse-error :text str :message "Empty string"))
|
|
|
859
|
+ (let* ((has-sign (or (char= (char str 0) #\-) (char= (char str 0) #\+)))
|
|
|
860
|
+ (sign (if (and has-sign (char= (char str 0) #\-)) -1 1))
|
|
|
861
|
+ (start (if has-sign 1 0)))
|
|
|
862
|
+ (cond
|
|
|
863
|
+ ((string= str "inf" :start1 start)
|
|
|
864
|
+ (if (= sign 1) double-float-positive-infinity double-float-negative-infinity))
|
|
|
865
|
+ ((string= str "nan" :start1 start) :nan)
|
|
|
866
|
+ (t
|
|
|
867
|
+ (unless (and (<= (+ start 2) len) (string= str "0x" :start1 start :end1 (+ start 2)))
|
|
|
868
|
+ (error 'hex-parse-error :text str :message "Missing '0x' prefix"))
|
|
|
869
|
+ (let ((p-pos (position #\p str :start start)))
|
|
|
870
|
+ (unless p-pos (error 'hex-parse-error :text str :message "Missing exponent 'p'"))
|
|
|
871
|
+
|
|
|
872
|
+ (loop for i from start below len
|
|
|
873
|
+ when (member (char str i) '(#\Space #\Tab #\Newline #\Return))
|
|
|
874
|
+ do (error 'hex-parse-error :text str :message "Internal whitespace detected"))
|
|
|
875
|
+
|
|
|
876
|
+ (let* ((sig-start (+ start 2))
|
|
|
877
|
+ (dot-pos (position #\. str :start sig-start :end p-pos))
|
|
|
878
|
+ (exp-start (1+ p-pos)))
|
|
|
879
|
+ (when (or (= sig-start p-pos)
|
|
|
880
|
+ (and dot-pos (= (1+ sig-start) p-pos) (= sig-start dot-pos)))
|
|
|
881
|
+ (error 'hex-parse-error :text str :message "No hex digits in significand"))
|
|
|
882
|
+
|
|
|
883
|
+ (handler-case
|
|
|
884
|
+ (let* ((frac-hex-len (if dot-pos (- p-pos (1+ dot-pos)) 0))
|
|
|
885
|
+ ;; 1. Parse significand as one large integer
|
|
|
886
|
+ (significand-int
|
|
|
887
|
+ (if (null dot-pos)
|
|
|
888
|
+ (parse-integer str :start sig-start :end p-pos :radix 16)
|
|
|
889
|
+ (let ((leading (if (= sig-start dot-pos) 0
|
|
|
890
|
+ (parse-integer str :start sig-start :end dot-pos :radix 16)))
|
|
|
891
|
+ (trailing (if (= (1+ dot-pos) p-pos) 0
|
|
|
892
|
+ (parse-integer str :start (1+ dot-pos) :end p-pos :radix 16))))
|
|
|
893
|
+ (+ (ash leading (* 4 frac-hex-len)) trailing))))
|
|
|
894
|
+ ;; 2. Parse exponent
|
|
|
895
|
+ (raw-exponent (parse-integer str :start exp-start :end len))
|
|
|
896
|
+ ;; 3. Build exact rational: significand / 16^frac-len * 2^exponent
|
|
|
897
|
+ (rational-val (* significand-int
|
|
|
898
|
+ (expt 2 (- raw-exponent (* 4 frac-hex-len))))))
|
|
|
899
|
+ ;; 4. Coerce to double-float
|
|
|
900
|
+ (* sign (float rational-val 1.0d0)))
|
|
|
901
|
+ (error (c) (error 'hex-parse-error :text str :message (format nil "~A" c)))))))))))
|
|
|
902
|
+
|
|
|
903
|
+#+nil
|
|
854
|
904
|
(defun parse-hex-float (str)
|
|
855
|
905
|
"Parses C-style hex strings into double-floats using robust integer scaling."
|
|
856
|
906
|
(let* ((str (string-trim '(#\Space #\Tab #\Newline #\Return) (string-downcase str)))
|