diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/code/cross-early.lisp | 17 | ||||
| -rw-r--r-- | src/code/cross-float.lisp | 42 |
2 files changed, 22 insertions, 37 deletions
diff --git a/src/code/cross-early.lisp b/src/code/cross-early.lisp index 068566ee2..9886991ad 100644 --- a/src/code/cross-early.lisp +++ b/src/code/cross-early.lisp @@ -43,6 +43,10 @@ (format 'single-float) (bits (error "unspecified %BITS") :type (signed-byte 32))) (:constructor %make-single-flonum (bits)))) + +(defmethod print-object ((obj single-float) stream) + (format stream "#.(MAKE-SINGLE-FLOAT #x~x)" (single-float-bits obj))) + (defun %single-bits-from (sign exponent mantissa) (declare (type bit sign) (type (unsigned-byte 8) exponent) @@ -59,6 +63,12 @@ (format 'double-float) (bits (error "unspecifier %BITS") :type (signed-byte 64))) (:constructor %make-double-flonum (bits)))) + +(defmethod print-object ((obj double-float) stream) + (format stream "#.(MAKE-DOUBLE-FLOAT #x~x #x~x)" + (double-float-high-bits obj) + (double-float-low-bits obj))) + (defun %double-bits-from (sign exponent mantissa) (declare (type bit sign) (type (unsigned-byte 11) exponent) @@ -152,6 +162,13 @@ (real nil :type real :read-only t) (imag nil :type real :read-only t)) +(defmethod print-object ((obj complexnum) stream) + (write-string "#.(COMPLEX " stream) + (prin1 (complexnum-real obj) stream) + (write-char #\Space stream) + (prin1 (complexnum-imag obj) stream) + (write-char #\) stream)) + (defun complex-single-float-p (x) (and (complexp x) (single-float-p (complexnum-real x)))) (defun complex-double-float-p (x) diff --git a/src/code/cross-float.lisp b/src/code/cross-float.lisp index 4e9dac6f2..83f9d5512 100644 --- a/src/code/cross-float.lisp +++ b/src/code/cross-float.lisp @@ -14,35 +14,6 @@ (in-package "SB-IMPL") (eval-when (:compile-toplevel :load-toplevel :execute) -;;; This choice exists because cold-init reads from "output/sxhash-calls.lisp-expr" -;;; using the ordinary definition of "#." which has to call the function at the car -;;; of a list; but warm.lisp uses a purpose-made #. reader that handles only 2 -;;; symbols, reducing the size of xfloat-math.lisp-expr by abbreviating the float -;;; constructors to single-character symbols. -(defvar *proxy-sfloat-ctor* "MAKE-SINGLE-FLOAT") -(defvar *proxy-dfloat-ctor* "MAKE-DOUBLE-FLOAT") -(labels - ((stringify (bits) (if (= bits 0) 0 (format nil "#x~x" bits))) - (output-part (x stream) - (typecase x - (single-float - (format stream "(~A ~A)" *proxy-sfloat-ctor* (stringify (single-float-bits x)))) - (double-float - (format stream "(~A ~A ~A)" *proxy-dfloat-ctor* - (stringify (double-float-high-bits x)) - (stringify (double-float-low-bits x)))) - (rational - (prin1 x stream))))) - (defmethod print-object ((self float) stream) - (write-string "#." stream) - (output-part self stream)) - - (defmethod print-object ((self complexnum) stream) - (write-string "#.(COMPLEX " stream) - (output-part (complexnum-real self) stream) - (write-char #\Space stream) - (output-part (complexnum-imag self) stream) - (write-char #\) stream))) ;;; To ensure that target numbers compare by EQL correctly under the host's ;;; definition of EQL (so that we don't have to intercept it and all else @@ -100,11 +71,10 @@ ;; Ensure that we're reading the correct variant of the file ;; in case there is more than one set of floating-point formats. (assert (eq (read stream) :default)) - (let ((pkg (make-package "SB-FLOAT-MATH-GENIE" :use '("CL"))) + (let ((pkg (make-package "SB-FLOAT-GENIE" :use '("CL"))) (line 0)) - (loop for (alias . actual) in '(("S" . sb-kernel:make-single-float) - ("D" . sb-kernel:make-double-float)) - do (setf (fdefinition (intern alias pkg)) (fdefinition actual))) + (import 'make-single-float pkg) + (import 'make-double-float pkg) (unwind-protect (dolist (expr (let ((*package* pkg)) (read stream))) (incf line) @@ -865,10 +835,8 @@ ;; Record each <fun,args> combination to STREAM ;; Though all symbols we print, such as SINGLE-FLOAT, are accessible ;; in any of the SB- packages, ABCL would buggily output package prefixes - ;; if ~S is used here. The intent is to use only SBCL as host to compute - ;; the table, since we assume that everybody's math routines suck. - ;; But anyway, this does seem to work in most other lisps. - (let ((*print-pretty* nil) (*proxy-sfloat-ctor* "S") (*proxy-dfloat-ctor* "D")) + ;; if ~S is used here. + (let ((*print-pretty* nil)) (maphash (lambda (key result) (destructuring-bind (fun . args) key (format stream "(~A ~A~{ ~A~})~%" |