X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fknownfun.lisp;h=e12181513dec21e881f2fc81d37c0c566883ff17;hb=5745b5a5b2e3b967bf3876b4306f31b3c78495fa;hp=811b0be935957ecfc1501ffe82032a7fb18d7cc3;hpb=43caa89c20c70fdef77797fe31e6fd09bfcf2527;p=sbcl.git

diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp
index 811b0be..e121815 100644
--- a/src/compiler/knownfun.lisp
+++ b/src/compiler/knownfun.lisp
@@ -61,6 +61,10 @@
   ;; in the safe code. If a function MUST signal errors, then it is
   ;; not unsafely-flushable even if it is movable or foldable.
   unsafely-flushable
+  ;; return value is important, and ignoring it is probably a mistake.
+  ;; Unlike the other attributes, this is used only for style
+  ;; warnings and has no effect on optimization.
+  important-result
   ;; may be moved with impunity. Has no side effects except possibly
   ;; consing, and is affected only by its arguments.
   ;;
@@ -81,7 +85,12 @@
   ;; The function does explicit argument type checking, so the
   ;; declared type should not be asserted when a definition is
   ;; compiled.
-  explicit-check)
+  explicit-check
+  ;; The function should always be translated by a VOP (i.e. it should
+  ;; should never be converted into a full call).  This is used strictly
+  ;; as a consistency checking mechanism inside the compiler during IR2
+  ;; transformation.
+  always-translatable)
 
 (defstruct (fun-info #-sb-xc-host (:pure t))
   ;; boolean attributes of this function.
@@ -122,7 +131,10 @@
   (templates nil :type list)
   ;; If non-null, then this function is a unary type predicate for
   ;; this type.
-  (predicate-type nil :type (or ctype null)))
+  (predicate-type nil :type (or ctype null))
+  ;; If non-null, the index of the argument which becomes the result
+  ;; of the function.
+  (result-arg nil :type (or index null)))
 
 (defprinter (fun-info)
   (attributes :test (not (zerop attributes))
@@ -173,7 +185,8 @@
                               (eq (transform-important x) important)))
                        (fun-info-transforms info))))
     (cond (old
-           (style-warn "Overwriting ~S" old)
+           (style-warn 'sb!kernel:redefinition-with-deftransform
+                       :transform old)
            (setf (transform-function old) fun
                  (transform-note old) note))
           (t
@@ -186,15 +199,18 @@
 ;;; and optimizers.
 (declaim (ftype (function (list list attributes &key
                                 (:derive-type (or function null))
-                                (:optimizer (or function null)))
+                                (:optimizer (or function null))
+                                (:destroyed-constant-args (or function null))
+                                (:result-arg (or index null)))
                           *)
                 %defknown))
-(defun %defknown (names type attributes &key derive-type optimizer destroyed-constant-args)
+(defun %defknown (names type attributes &key derive-type optimizer destroyed-constant-args result-arg)
   (let ((ctype (specifier-type type))
         (info (make-fun-info :attributes attributes
                              :derive-type derive-type
                              :optimizer optimizer
-                             :destroyed-constant-args destroyed-constant-args))
+                             :destroyed-constant-args destroyed-constant-args
+                             :result-arg result-arg))
         (target-env *info-environment*))
     (dolist (name names)
       (let ((old-fun-info (info :function :info name)))