From: Christophe Rhodes Date: Mon, 2 Dec 2002 16:59:08 +0000 (+0000) Subject: 0.7.10.8: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d8346491af87b66677657e4b934ddeae1e749250;p=sbcl.git 0.7.10.8: Staging-post on the way to working INLINE/MACROLET ... implement previously (MACROLET ((DEF ...)) (DEF ...)) INLINE functions as defined by global !DEF macros ... don't touch SORT-VECTOR, as it is complicated ... implement a BUG 117 bogowarning workaround in code/defstruct.lisp The plan from here is to move FIND and friends into the realm of SOURCE-TRANSFORMS, so that the cross-compiler is born knowing how to compile FIND; a similar solution is likely for SORT-VECTOR. Then defensive code can be written around a version of MAYBE-INLINE-SYNTACTIC-CLOSURE (as per CSR sbcl-devel 2002-07-02 "BUG 156 and INLINE FIND"), and voilà! working INLINE. --- diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 2adbc99..eece961 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -1523,8 +1523,12 @@ (let ((dsd (find (symbol-name slot-name) dd-slots :key #'dsd-%name :test #'string=))) + ;; KLUDGE: bug 117 bogowarning. Neither + ;; DECLAREing the type nor TRULY-THE cut + ;; the mustard -- it still gives warnings. + (enforce-type dsd defstruct-slot-description) `(setf (,(dsd-accessor-name dsd) ,object-gensym) - ,slot-name))) + ,slot-name))) slot-names) ,object-gensym)) diff --git a/src/code/float.lisp b/src/code/float.lisp index 4f411f2..91bafe6 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -196,59 +196,60 @@ (and (zerop (ldb sb!vm:long-float-exponent-byte (long-float-exp-bits x))) (not (zerop x)))))) -(macrolet ((def (name doc single double #!+(and long-float x86) long) - `(defun ,name (x) - ,doc - (number-dispatch ((x float)) - ((single-float) - (let ((bits (single-float-bits x))) - (and (> (ldb sb!vm:single-float-exponent-byte bits) - sb!vm:single-float-normal-exponent-max) - ,single))) - ((double-float) - (let ((hi (double-float-high-bits x)) - (lo (double-float-low-bits x))) - (declare (ignorable lo)) - (and (> (ldb sb!vm:double-float-exponent-byte hi) - sb!vm:double-float-normal-exponent-max) - ,double))) - #!+(and long-float x86) - ((long-float) - (let ((exp (long-float-exp-bits x)) - (hi (long-float-high-bits x)) - (lo (long-float-low-bits x))) - (declare (ignorable lo)) - (and (> (ldb sb!vm:long-float-exponent-byte exp) - sb!vm:long-float-normal-exponent-max) - ,long))))))) - - (def float-infinity-p - "Return true if the float X is an infinity (+ or -)." - (zerop (ldb sb!vm:single-float-significand-byte bits)) - (and (zerop (ldb sb!vm:double-float-significand-byte hi)) - (zerop lo)) - #!+(and long-float x86) - (and (zerop (ldb sb!vm:long-float-significand-byte hi)) - (zerop lo))) - - (def float-nan-p - "Return true if the float X is a NaN (Not a Number)." - (not (zerop (ldb sb!vm:single-float-significand-byte bits))) - (or (not (zerop (ldb sb!vm:double-float-significand-byte hi))) - (not (zerop lo))) - #!+(and long-float x86) - (or (not (zerop (ldb sb!vm:long-float-significand-byte hi))) - (not (zerop lo)))) - - (def float-trapping-nan-p - "Return true if the float X is a trapping NaN (Not a Number)." - (zerop (logand (ldb sb!vm:single-float-significand-byte bits) - sb!vm:single-float-trapping-nan-bit)) - (zerop (logand (ldb sb!vm:double-float-significand-byte hi) - sb!vm:double-float-trapping-nan-bit)) - #!+(and long-float x86) - (zerop (logand (ldb sb!vm:long-float-significand-byte hi) - sb!vm:long-float-trapping-nan-bit)))) +(defmacro !define-float-dispatching-function + (name doc single double #!+(and long-float x86) long) + `(defun ,name (x) + ,doc + (number-dispatch ((x float)) + ((single-float) + (let ((bits (single-float-bits x))) + (and (> (ldb sb!vm:single-float-exponent-byte bits) + sb!vm:single-float-normal-exponent-max) + ,single))) + ((double-float) + (let ((hi (double-float-high-bits x)) + (lo (double-float-low-bits x))) + (declare (ignorable lo)) + (and (> (ldb sb!vm:double-float-exponent-byte hi) + sb!vm:double-float-normal-exponent-max) + ,double))) + #!+(and long-float x86) + ((long-float) + (let ((exp (long-float-exp-bits x)) + (hi (long-float-high-bits x)) + (lo (long-float-low-bits x))) + (declare (ignorable lo)) + (and (> (ldb sb!vm:long-float-exponent-byte exp) + sb!vm:long-float-normal-exponent-max) + ,long)))))) + +(!define-float-dispatching-function float-infinity-p + "Return true if the float X is an infinity (+ or -)." + (zerop (ldb sb!vm:single-float-significand-byte bits)) + (and (zerop (ldb sb!vm:double-float-significand-byte hi)) + (zerop lo)) + #!+(and long-float x86) + (and (zerop (ldb sb!vm:long-float-significand-byte hi)) + (zerop lo))) + +(!define-float-dispatching-function float-nan-p + "Return true if the float X is a NaN (Not a Number)." + (not (zerop (ldb sb!vm:single-float-significand-byte bits))) + (or (not (zerop (ldb sb!vm:double-float-significand-byte hi))) + (not (zerop lo))) + #!+(and long-float x86) + (or (not (zerop (ldb sb!vm:long-float-significand-byte hi))) + (not (zerop lo)))) + +(!define-float-dispatching-function float-trapping-nan-p + "Return true if the float X is a trapping NaN (Not a Number)." + (zerop (logand (ldb sb!vm:single-float-significand-byte bits) + sb!vm:single-float-trapping-nan-bit)) + (zerop (logand (ldb sb!vm:double-float-significand-byte hi) + sb!vm:double-float-trapping-nan-bit)) + #!+(and long-float x86) + (zerop (logand (ldb sb!vm:long-float-significand-byte hi) + sb!vm:long-float-trapping-nan-bit))) ;;; If denormalized, use a subfunction from INTEGER-DECODE-FLOAT to find the ;;; actual exponent (and hence how denormalized it is), otherwise we just diff --git a/src/code/seq.lisp b/src/code/seq.lisp index dc39f2f..aee2434 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -1964,46 +1964,36 @@ ;;; the user interface to FIND and POSITION: Get all our ducks in a ;;; row, then call %FIND-POSITION. (declaim (inline find position)) -(macrolet ((def-find-position (fun-name values-index) - `(defun ,fun-name (item - sequence - &key - from-end - (start 0) - end - key - test - test-not) - (nth-value - ,values-index - (%find-position item - sequence - from-end - start - end - (effective-find-position-key key) - (effective-find-position-test test - test-not)))))) - (def-find-position find 0) - (def-find-position position 1)) +(defmacro !def-find-position (fun-name values-index) + `(defun ,fun-name (item sequence &key + from-end (start 0) end + key test test-not) + (nth-value + ,values-index + (%find-position item sequence + from-end start + end (effective-find-position-key key) + (effective-find-position-test test test-not))))) +(!def-find-position find 0) +(!def-find-position position 1) ;;; the user interface to FIND-IF and POSITION-IF, entirely analogous ;;; to the interface to FIND and POSITION (declaim (inline find-if position-if)) -(macrolet ((def-find-position-if (fun-name values-index) - `(defun ,fun-name (predicate sequence - &key from-end (start 0) end key) - (nth-value - ,values-index - (%find-position-if (%coerce-callable-to-fun predicate) - sequence - from-end - start - end - (effective-find-position-key key)))))) - - (def-find-position-if find-if 0) - (def-find-position-if position-if 1)) +(defmacro !def-find-position-if (fun-name values-index) + `(defun ,fun-name (predicate sequence + &key from-end (start 0) end key) + (nth-value + ,values-index + (%find-position-if (%coerce-callable-to-fun predicate) + sequence + from-end + start + end + (effective-find-position-key key))))) + +(!def-find-position-if find-if 0) +(!def-find-position-if position-if 1) ;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We ;;; didn't bother to worry about optimizing them, except note that on @@ -2026,20 +2016,20 @@ ;;; FIXME: Maybe remove uses of these deprecated functions (and ;;; definitely of :TEST-NOT) within the implementation of SBCL. (declaim (inline find-if-not position-if-not)) -(macrolet ((def-find-position-if-not (fun-name values-index) - `(defun ,fun-name (predicate sequence - &key from-end (start 0) end key) - (nth-value - ,values-index - (%find-position-if-not (%coerce-callable-to-fun predicate) - sequence - from-end - start - end - (effective-find-position-key key)))))) - - (def-find-position-if-not find-if-not 0) - (def-find-position-if-not position-if-not 1)) +(defmacro !def-find-position-if-not (fun-name values-index) + `(defun ,fun-name (predicate sequence + &key from-end (start 0) end key) + (nth-value + ,values-index + (%find-position-if-not (%coerce-callable-to-fun predicate) + sequence + from-end + start + end + (effective-find-position-key key))))) + +(!def-find-position-if-not find-if-not 0) +(!def-find-position-if-not position-if-not 1) ;;;; COUNT-IF, COUNT-IF-NOT, and COUNT diff --git a/src/code/sort.lisp b/src/code/sort.lisp index 78c291d..afff387 100644 --- a/src/code/sort.lisp +++ b/src/code/sort.lisp @@ -72,7 +72,7 @@ (rotatef (%elt 1) (%elt current-heap-size)) (decf current-heap-size) (%heapify 1)))))) - + ;; FIXME: Oh dear. (declaim (inline sort-vector)) (defun sort-vector (vector start end predicate key) (declare (type vector vector)) diff --git a/version.lisp-expr b/version.lisp-expr index 2e5748d..7ba229d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.10.7" +"0.7.10.8"