0.8.1.8:
authorWilliam Harold Newman <william.newman@airmail.net>
Thu, 26 Jun 2003 19:36:02 +0000 (19:36 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Thu, 26 Jun 2003 19:36:02 +0000 (19:36 +0000)
There seems to be no reason to use LET () instead of PROGN in
the #+SB-XC-HOST case of !COLD-INIT-FORMS; and the
nontoplevelness caused a problem (*QUEUED-PROCLAIMS*
not declared special before use, because DEFVAR wasn't
at toplevel when wrapped in LET (); then reported as
full warning by xc host) reported by KingNato on #lisp.
broke some long lines noticed when looking at !C-I-F forms
Even though the new !COLD-INIT-FORMS-as-PROGN might suffice to
allow the system to build on MacOS without WARNINGs,
without further change, it seemed easier to understand
if I moved the DEFVAR *Q-P* outside the !C-I-F, leaving
only SETF inside, so I did.

src/code/cold-init-helper-macros.lisp
src/code/late-type.lisp
src/compiler/proclaim.lisp
version.lisp-expr

index f34c5d9..bcf619e 100644 (file)
@@ -41,7 +41,7 @@
   ;; meaningful concept and in any case would have happened long ago,
   ;; so just execute the forms at load time (i.e. basically as soon as
   ;; possible).
-  #+sb-xc-host `(let () ,@forms))
+  #+sb-xc-host `(progn ,@forms))
 
 (defmacro !defun-from-collected-cold-init-forms (name)
   #-sb-xc-host `(progn
index dd6c403..8e07447 100644 (file)
                    ((fun-type-wild-args type1)
                     (cond ((fun-type-keyp type2) (values nil nil))
                           ((not (fun-type-rest type2)) (values nil t))
-                          ((not (null (fun-type-required type2))) (values nil t))
-                          (t (and/type (type= *universal-type* (fun-type-rest type2))
-                                       (every/type #'type= *universal-type*
-                                                   (fun-type-optional type2))))))
+                          ((not (null (fun-type-required type2)))
+                          (values nil t))
+                          (t (and/type (type= *universal-type*
+                                             (fun-type-rest type2))
+                                       (every/type #'type=
+                                                  *universal-type*
+                                                   (fun-type-optional
+                                                   type2))))))
                    ((not (and (fun-type-simple-p type1)
                               (fun-type-simple-p type2)))
                     (values nil nil))
                           (cond ((or (> max1 max2) (< min1 min2))
                                  (values nil t))
                                 ((and (= min1 min2) (= max1 max2))
-                                 (and/type (every-csubtypep (fun-type-required type1)
-                                                            (fun-type-required type2))
-                                           (every-csubtypep (fun-type-optional type1)
-                                                            (fun-type-optional type2))))
+                                 (and/type (every-csubtypep
+                                           (fun-type-required type1)
+                                           (fun-type-required type2))
+                                           (every-csubtypep
+                                           (fun-type-optional type1)
+                                           (fun-type-optional type2))))
                                 (t (every-csubtypep
                                     (concatenate 'list
                                                  (fun-type-required type1)
          ((consp low-bound)
           (let ((low-value (car low-bound)))
             (or (eql low-value high-bound)
-                (and (eql low-value (load-time-value (make-unportable-float :single-float-negative-zero))) (eql high-bound 0f0))
-                (and (eql low-value 0f0) (eql high-bound (load-time-value (make-unportable-float :single-float-negative-zero))))
-                (and (eql low-value (load-time-value (make-unportable-float :double-float-negative-zero))) (eql high-bound 0d0))
-                (and (eql low-value 0d0) (eql high-bound (load-time-value (make-unportable-float :double-float-negative-zero)))))))
+                (and (eql low-value
+                          (load-time-value (make-unportable-float
+                                            :single-float-negative-zero)))
+                     (eql high-bound 0f0))
+                (and (eql low-value 0f0)
+                     (eql high-bound
+                          (load-time-value (make-unportable-float
+                                            :single-float-negative-zero))))
+                (and (eql low-value
+                          (load-time-value (make-unportable-float
+                                            :double-float-negative-zero)))
+                     (eql high-bound 0d0))
+                (and (eql low-value 0d0)
+                     (eql high-bound
+                          (load-time-value (make-unportable-float
+                                            :double-float-negative-zero)))))))
          ((consp high-bound)
           (let ((high-value (car high-bound)))
             (or (eql high-value low-bound)
-                (and (eql high-value (load-time-value (make-unportable-float :single-float-negative-zero))) (eql low-bound 0f0))
-                (and (eql high-value 0f0) (eql low-bound (load-time-value (make-unportable-float :single-float-negative-zero))))
-                (and (eql high-value (load-time-value (make-unportable-float :double-float-negative-zero))) (eql low-bound 0d0))
-                (and (eql high-value 0d0) (eql low-bound (load-time-value (make-unportable-float :double-float-negative-zero)))))))
+                (and (eql high-value
+                          (load-time-value (make-unportable-float
+                                            :single-float-negative-zero)))
+                     (eql low-bound 0f0))
+                (and (eql high-value 0f0)
+                     (eql low-bound
+                          (load-time-value (make-unportable-float
+                                            :single-float-negative-zero))))
+                (and (eql high-value
+                          (load-time-value (make-unportable-float
+                                            :double-float-negative-zero)))
+                     (eql low-bound 0d0))
+                (and (eql high-value 0d0)
+                     (eql low-bound
+                          (load-time-value (make-unportable-float
+                                            :double-float-negative-zero)))))))
          ((and (eq (numeric-type-class low) 'integer)
                (eq (numeric-type-class high) 'integer))
           (eql (1+ low-bound) high-bound))
index 1609080..8c48392 100644 (file)
            (t
             decl-spec)))))
 
+(defvar *queued-proclaims*) ; initialized in !COLD-INIT-FORMS
+
 (!begin-collecting-cold-init-forms)
-(!cold-init-forms (defvar *queued-proclaims* nil))
+(!cold-init-forms (setf *queued-proclaims* nil))
 (!defun-from-collected-cold-init-forms !early-proclaim-cold-init)
 
 (defun sb!xc:proclaim (raw-form)
index 65691ce..2f31f00 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.1.7"
+"0.8.1.8"