(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))
;; 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)
;;;; 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))
(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.
;;; 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"