1.0.47.24: more conservative FTYPE proclamations
authorNikodemus Siivola <nikodemus@random-state.net>
Mon, 11 Apr 2011 11:32:50 +0000 (11:32 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Mon, 11 Apr 2011 11:32:50 +0000 (11:32 +0000)
  Full warnings for changing FTYPE proclamations in the
  cross-compiler, and always a CERROR when the function is a known one
  and the new type is not a subtype of the old one.

  This necessitates the following changes:

  * Rewriting DEF-MATH-RTN not to use DEFINE-ALIEN-ROUTINE which
    proclaims its FTYPE.

  * Fix the DEFKNOWN for CLASSOID-NAME to match the DEFSTRUCT.

  * Fix STRING-OUTPUT-STREAM-ELEMENT-TYPE slot type, and DEFKNOWN
    result type.

src/code/irrat.lisp
src/code/stream.lisp
src/compiler/fndb.lisp
src/compiler/proclaim.lisp
version.lisp-expr

index 71619ee..1b28a3a 100644 (file)
 (eval-when (:compile-toplevel :execute)
 
 (sb!xc:defmacro def-math-rtn (name num-args)
-  (let ((function (symbolicate "%" (string-upcase name))))
+  (let ((function (symbolicate "%" (string-upcase name)))
+        (args (let ((sb!impl::*gentemp-counter* 0))
+                (loop repeat num-args collect (gentemp "ARG")))))
     `(progn
        (declaim (inline ,function))
-       (sb!alien:define-alien-routine (,name ,function) double-float
-         ,@(let ((results nil))
-             (dotimes (i num-args (nreverse results))
-               (push (list (intern (format nil "ARG-~D" i))
-                           'double-float)
-                     results)))))))
+       (defun ,function ,args
+         (alien-funcall
+          (extern-alien ,name
+                        (function double-float
+                                  ,@(loop repeat num-args
+                                          collect 'double-float)))
+          ,@args)))))
 
 (defun handle-reals (function var)
   `((((foreach fixnum single-float bignum ratio))
index 3065d16..71adb3a 100644 (file)
   ;; end of the stream.
   (index-cache 0 :type index)
   ;; Requested element type
-  (element-type 'character))
+  (element-type 'character :type type-specifier))
 
 #!+sb-doc
 (setf (fdocumentation 'make-string-output-stream 'function)
index 77be6fa..f86bff6 100644 (file)
@@ -80,7 +80,7 @@
 ;;;; classes
 
 (sb!xc:deftype name-for-class () t)
-(defknown classoid-name (classoid) name-for-class (flushable))
+(defknown classoid-name (classoid) symbol (flushable))
 (defknown find-classoid (name-for-class &optional t)
   (or classoid null) ())
 (defknown classoid-of (t) classoid (flushable))
   (flushable unsafe))
 (defknown make-string-output-stream
     (&key (:element-type type-specifier))
-    stream
+    string-output-stream
   (flushable))
 (defknown get-output-stream-string (stream) simple-string ())
 (defknown streamp (t) boolean (movable foldable flushable))
index d0231ce..755467a 100644 (file)
                      (when (type/= ctype old-type)
                        ;; FIXME: changing to FTYPE-PROCLAMATION-MISMATCH
                        ;; broke late-proclaim.lisp.
-                       (style-warn
-                        "~@<new FTYPE proclamation for ~S~@:_  ~S~@:_~
-                       does not match the old FTYPE proclamation:~@:_  ~S~@:>"
-                        name (type-specifier ctype) (type-specifier old-type)))))
-
+                       (if (info :function :info name)
+                           ;; Allow for tightening of known function types
+                           (unless (csubtypep ctype old-type)
+                             (cerror "Continue"
+                                     "~@<new FTYPE proclamation for known function ~S~@:_  ~S~@:_~
+                                      does not match its old FTYPE:~@:_  ~S~@:>"
+                                     name (type-specifier ctype) (type-specifier old-type)))
+                           (#+sb-xc-host warn
+                            #-sb-xc-host style-warn
+                            "~@<new FTYPE proclamation for ~S~@:_  ~S~@:_~
+                             does not match the old FTYPE proclamation:~@:_  ~S~@:>"
+                            name (type-specifier ctype) (type-specifier old-type))))))
                  ;; Now references to this function shouldn't be warned
                  ;; about as undefined, since even if we haven't seen a
                  ;; definition yet, we know one is planned.
index 6e2883f..d4d0951 100644 (file)
@@ -20,4 +20,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".)
-"1.0.47.23"
+"1.0.47.24"