New TN cost computation: directly take depth into account
[sbcl.git] / src / compiler / fndb.lisp
index 1aef68d..9fadaf9 100644 (file)
 
 (defknown (eq eql) (t t) boolean (movable foldable flushable))
 (defknown (equal equalp) (t t) boolean (foldable flushable recursive))
 
 (defknown (eq eql) (t t) boolean (movable foldable flushable))
 (defknown (equal equalp) (t t) boolean (foldable flushable recursive))
+
+#!+(or x86 x86-64)
+(defknown fixnum-mod-p (t fixnum) boolean
+    (movable foldable flushable always-translatable))
+
 \f
 ;;;; classes
 
 \f
 ;;;; classes
 
@@ -86,7 +91,7 @@
 (defknown classoid-of (t) classoid (flushable))
 (defknown layout-of (t) layout (flushable))
 (defknown copy-structure (structure-object) structure-object
 (defknown classoid-of (t) classoid (flushable))
 (defknown layout-of (t) layout (flushable))
 (defknown copy-structure (structure-object) structure-object
-  (flushable))
+  (flushable)) ;; FIXME: can derive the type based on the structure
 \f
 ;;;; from the "Control Structure" chapter:
 
 \f
 ;;;; from the "Control Structure" chapter:
 
   :derive-type #'result-type-last-arg)
 (defknown fdefinition ((or symbol cons)) function (explicit-check))
 (defknown %set-fdefinition ((or symbol cons) function) function
   :derive-type #'result-type-last-arg)
 (defknown fdefinition ((or symbol cons)) function (explicit-check))
 (defknown %set-fdefinition ((or symbol cons) function) function
-  (explicit-check))
-(defknown makunbound (symbol) symbol)
+  (explicit-check)
+  :derive-type #'result-type-last-arg)
+(defknown makunbound (symbol) symbol
+  ()
+  :derive-type #'result-type-first-arg)
 (defknown fmakunbound ((or symbol cons)) (or symbol cons)
 (defknown fmakunbound ((or symbol cons)) (or symbol cons)
-  (explicit-check))
+  (explicit-check)
+  :derive-type #'result-type-first-arg)
 (defknown apply (callable t &rest t) *) ; ### Last arg must be List...
 (defknown funcall (callable &rest t) *)
 
 (defknown apply (callable t &rest t) *) ; ### Last arg must be List...
 (defknown funcall (callable &rest t) *)
 
 ;;;; from the "Symbols" chapter:
 
 (defknown get (symbol t &optional t) t (flushable))
 ;;;; from the "Symbols" chapter:
 
 (defknown get (symbol t &optional t) t (flushable))
-(defknown sb!impl::get2 (symbol t) t (flushable))
 (defknown sb!impl::get3 (symbol t t) t (flushable))
 (defknown remprop (symbol t) t)
 (defknown symbol-plist (symbol) list (flushable))
 (defknown sb!impl::get3 (symbol t t) t (flushable))
 (defknown remprop (symbol t) t)
 (defknown symbol-plist (symbol) list (flushable))
                  char-lessp char-greaterp char-not-greaterp char-not-lessp)
   (character &rest character) boolean (movable foldable flushable))
 
                  char-lessp char-greaterp char-not-greaterp char-not-lessp)
   (character &rest character) boolean (movable foldable flushable))
 
+(defknown (two-arg-char-equal
+           two-arg-char-not-equal
+           two-arg-char-lessp
+           two-arg-char-not-lessp
+           two-arg-char-greaterp
+           two-arg-char-not-greaterp)
+    (character character) boolean (movable foldable flushable))
+
+(defknown char-equal-constant (character character character)
+  boolean
+  (movable foldable flushable explicit-check))
+
 (defknown character (t) character (movable foldable unsafely-flushable))
 (defknown char-code (character) char-code (movable foldable flushable))
 (defknown (char-upcase char-downcase) (character) character
 (defknown character (t) character (movable foldable unsafely-flushable))
 (defknown char-code (character) char-code (movable foldable flushable))
 (defknown (char-upcase char-downcase) (character) character
   ()
   :derive-type (creation-result-type-specifier-nth-arg 1))
 
   ()
   :derive-type (creation-result-type-specifier-nth-arg 1))
 
+(defknown %concatenate-to-string (&rest sequence) simple-string
+  (explicit-check flushable))
+(defknown %concatenate-to-base-string (&rest sequence) simple-base-string
+  (explicit-check flushable))
+
 (defknown (map %map) (type-specifier callable sequence &rest sequence)
   consed-sequence
   (call)
 (defknown (map %map) (type-specifier callable sequence &rest sequence)
   consed-sequence
   (call)
 (defknown %map-to-list-arity-1 (callable sequence) list (flushable call))
 (defknown %map-to-simple-vector-arity-1 (callable sequence) simple-vector
   (flushable call))
 (defknown %map-to-list-arity-1 (callable sequence) list (flushable call))
 (defknown %map-to-simple-vector-arity-1 (callable sequence) simple-vector
   (flushable call))
-(defknown %map-to-nil-on-simple-vector (callable simple-vector) null
-  (flushable call))
-(defknown %map-to-nil-on-vector (callable vector) null (flushable call))
-(defknown %map-to-nil-on-sequence (callable sequence) null (flushable call))
 
 (defknown map-into (sequence callable &rest sequence)
   sequence
 
 (defknown map-into (sequence callable &rest sequence)
   sequence
   :derive-type (creation-result-type-specifier-nth-arg 1)
   :destroyed-constant-args (nth-constant-nonempty-sequence-args 2 3))
 
   :derive-type (creation-result-type-specifier-nth-arg 1)
   :destroyed-constant-args (nth-constant-nonempty-sequence-args 2 3))
 
-;;; not FLUSHABLE, despite what CMU CL's DEFKNOWN said..
 (defknown read-sequence (sequence stream
                                   &key
                                   (:start index)
 (defknown read-sequence (sequence stream
                                   &key
                                   (:start index)
                                    (:end sequence-end))
   sequence
   ()
                                    (:end sequence-end))
   sequence
   ()
-  :derive-type (sequence-result-nth-arg 1))
+  :derive-type #'result-type-first-arg)
 \f
 ;;;; from the "Manipulating List Structure" chapter:
 (defknown (car cdr first rest)
 \f
 ;;;; from the "Manipulating List Structure" chapter:
 (defknown (car cdr first rest)
   :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown ldiff (list t) list (flushable))
   :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
 
 (defknown ldiff (list t) list (flushable))
-(defknown (rplaca rplacd) (cons t) list ()
+(defknown (rplaca rplacd) (cons t) cons ()
   :destroyed-constant-args (nth-constant-args 1))
 
 (defknown subst (t t t &key (:key callable) (:test callable)
   :destroyed-constant-args (nth-constant-args 1))
 
 (defknown subst (t t t &key (:key callable) (:test callable)
 
 (defknown adjoin (t list &key (:key callable) (:test callable)
                     (:test-not callable))
 
 (defknown adjoin (t list &key (:key callable) (:test callable)
                     (:test-not callable))
-  list (foldable flushable call))
+  cons (flushable call))
 
 (defknown (union intersection set-difference set-exclusive-or)
   (list list &key (:key callable) (:test callable) (:test-not callable))
 
 (defknown (union intersection set-difference set-exclusive-or)
   (list list &key (:key callable) (:test callable) (:test-not callable))
   boolean
   (foldable flushable call))
 
   boolean
   (foldable flushable call))
 
-(defknown acons (t t t) list (movable flushable))
+(defknown acons (t t t) cons (movable flushable))
 (defknown pairlis (t t &optional t) list (flushable))
 
 (defknown (rassoc assoc)
 (defknown pairlis (t t &optional t) list (flushable))
 
 (defknown (rassoc assoc)
 (defknown hash-table-p (t) boolean (movable foldable flushable))
 (defknown gethash (t hash-table &optional t) (values t boolean)
   (flushable)) ; not FOLDABLE, since hash table contents can change
 (defknown hash-table-p (t) boolean (movable foldable flushable))
 (defknown gethash (t hash-table &optional t) (values t boolean)
   (flushable)) ; not FOLDABLE, since hash table contents can change
-(defknown sb!impl::gethash2 (t hash-table) (values t boolean)
-  (flushable)) ; not FOLDABLE, since hash table contents can change
 (defknown sb!impl::gethash3 (t hash-table t) (values t boolean)
   (flushable)) ; not FOLDABLE, since hash table contents can change
 (defknown %puthash (t hash-table t) t ()
 (defknown sb!impl::gethash3 (t hash-table t) (values t boolean)
   (flushable)) ; not FOLDABLE, since hash table contents can change
 (defknown %puthash (t hash-table t) t ()
-  :destroyed-constant-args (nth-constant-args 2))
+  :destroyed-constant-args (nth-constant-args 2)
+  :derive-type #'result-type-last-arg)
 (defknown remhash (t hash-table) boolean ()
   :destroyed-constant-args (nth-constant-args 2))
 (defknown maphash (callable hash-table) null (flushable call))
 (defknown remhash (t hash-table) boolean ()
   :destroyed-constant-args (nth-constant-args 2))
 (defknown maphash (callable hash-table) null (flushable call))
 (defknown hash-table-test (hash-table) symbol (foldable flushable))
 (defknown sxhash (t) hash (#-sb-xc-host foldable flushable))
 (defknown psxhash (t &optional t) hash (#-sb-xc-host foldable flushable))
 (defknown hash-table-test (hash-table) symbol (foldable flushable))
 (defknown sxhash (t) hash (#-sb-xc-host foldable flushable))
 (defknown psxhash (t &optional t) hash (#-sb-xc-host foldable flushable))
+(defknown hash-table-equalp (hash-table hash-table) boolean (foldable flushable))
 \f
 ;;;; from the "Arrays" chapter
 
 \f
 ;;;; from the "Arrays" chapter
 
 (defknown streamp (t) boolean (movable foldable flushable))
 (defknown stream-element-type (stream) type-specifier
   (movable foldable flushable))
 (defknown streamp (t) boolean (movable foldable flushable))
 (defknown stream-element-type (stream) type-specifier
   (movable foldable flushable))
+(defknown stream-external-format (stream) t (flushable))
 (defknown (output-stream-p input-stream-p) (stream) boolean
   (movable foldable flushable))
 (defknown (output-stream-p input-stream-p) (stream) boolean
   (movable foldable flushable))
+(defknown open-stream-p (stream) boolean (flushable))
 (defknown close (stream &key (:abort t)) (eql t) ())
 (defknown close (stream &key (:abort t)) (eql t) ())
+(defknown file-string-length (ansi-stream (or string character))
+  (or unsigned-byte null)
+  (flushable))
 \f
 ;;;; from the "Input/Output" chapter:
 
 \f
 ;;;; from the "Input/Output" chapter:
 
      (:lines (or unsigned-byte null))
      (:right-margin (or unsigned-byte null))
      (:miser-width (or unsigned-byte null))
      (:lines (or unsigned-byte null))
      (:right-margin (or unsigned-byte null))
      (:miser-width (or unsigned-byte null))
-     (:pprint-dispatch t))
+     (:pprint-dispatch t)
+     (:suppress-errors t))
   t
   (any explicit-check)
   :derive-type #'result-type-first-arg)
   t
   (any explicit-check)
   :derive-type #'result-type-first-arg)
   (any explicit-check)
   :derive-type #'result-type-first-arg)
 
   (any explicit-check)
   :derive-type #'result-type-first-arg)
 
+(defknown (pprint) (t &optional stream-designator) (values)
+  (explicit-check))
+
 ;;; xxx-TO-STRING functions are not foldable because they depend on
 ;;; the dynamic environment, the state of the pretty printer dispatch
 ;;; table, and probably other run-time factors.
 ;;; xxx-TO-STRING functions are not foldable because they depend on
 ;;; the dynamic environment, the state of the pretty printer dispatch
 ;;; table, and probably other run-time factors.
 (defknown (prin1-to-string princ-to-string) (t) simple-string (flushable))
 
 (defknown write-char (character &optional stream-designator) character
 (defknown (prin1-to-string princ-to-string) (t) simple-string (flushable))
 
 (defknown write-char (character &optional stream-designator) character
-  (explicit-check))
+  (explicit-check)
+  :derive-type #'result-type-first-arg)
+
 (defknown (write-string write-line)
   (string &optional stream-designator &key (:start index) (:end sequence-end))
   string
 (defknown (write-string write-line)
   (string &optional stream-designator &key (:start index) (:end sequence-end))
   string
-  (explicit-check))
+  (explicit-check)
+  :derive-type #'result-type-first-arg)
 
 (defknown (terpri finish-output force-output clear-output)
   (&optional stream-designator) null
 
 (defknown (terpri finish-output force-output clear-output)
   (&optional stream-designator) null
   (explicit-check))
 
 (defknown write-byte (integer stream) integer
   (explicit-check))
 
 (defknown write-byte (integer stream) integer
-  (explicit-check))
+  (explicit-check)
+  :derive-type #'result-type-first-arg)
 
 ;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS
 (defknown format ((or (member nil t) stream string)
 
 ;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS
 (defknown format ((or (member nil t) stream string)
 (defknown pathname-version (pathname-designator)
   pathname-version (flushable))
 
 (defknown pathname-version (pathname-designator)
   pathname-version (flushable))
 
+(defknown pathname= (pathname pathname) boolean (movable foldable flushable))
+
 (defknown (namestring file-namestring directory-namestring host-namestring)
   (pathname-designator) (or simple-string null)
   (unsafely-flushable))
 (defknown (namestring file-namestring directory-namestring host-namestring)
   (pathname-designator) (or simple-string null)
   (unsafely-flushable))
 
 (defknown rename-file (pathname-designator filename)
   (values pathname pathname pathname))
 
 (defknown rename-file (pathname-designator filename)
   (values pathname pathname pathname))
-(defknown delete-file (pathname-designator) t)
+(defknown delete-file (pathname-designator) (eql t))
 (defknown probe-file (pathname-designator) (or pathname null) ())
 (defknown file-write-date (pathname-designator) (or unsigned-byte null)
   ())
 (defknown probe-file (pathname-designator) (or pathname null) ())
 (defknown file-write-date (pathname-designator) (or unsigned-byte null)
   ())
    (:print t)
    (:if-does-not-exist t)
    (:external-format external-format-designator))
    (:print t)
    (:if-does-not-exist t)
    (:external-format external-format-designator))
-  t)
+  boolean)
 
 (defknown directory (pathname-designator &key (:resolve-symlinks t))
   list ())
 
 (defknown directory (pathname-designator &key (:resolve-symlinks t))
   list ())
    (:emit-cfasl t))
   (values (or pathname null) boolean boolean))
 
    (:emit-cfasl t))
   (values (or pathname null) boolean boolean))
 
+(defknown (compile-file-pathname)
+  (pathname-designator &key (:output-file (or pathname-designator
+                                              null
+                                              (member t)))
+                       &allow-other-keys)
+  pathname)
+
 ;; FIXME: consider making (OR CALLABLE CONS) something like
 ;; EXTENDED-FUNCTION-DESIGNATOR
 (defknown disassemble ((or callable cons) &key
 ;; FIXME: consider making (OR CALLABLE CONS) something like
 ;; EXTENDED-FUNCTION-DESIGNATOR
 (defknown disassemble ((or callable cons) &key
   null)
 
 (defknown describe (t &optional (or stream (member t nil))) (values))
   null)
 
 (defknown describe (t &optional (or stream (member t nil))) (values))
+(defknown function-lambda-expression (function) (values t boolean t))
 (defknown inspect (t) (values))
 (defknown room (&optional (member t nil :default)) (values))
 (defknown ed (&optional (or symbol cons filename))
 (defknown inspect (t) (values))
 (defknown room (&optional (member t nil :default)) (values))
 (defknown ed (&optional (or symbol cons filename))
 
 (defknown sleep ((real 0)) null (explicit-check))
 
 
 (defknown sleep ((real 0)) null (explicit-check))
 
+(defknown call-with-timing (callable callable &rest t) *
+  (call))
+
 ;;; Even though ANSI defines LISP-IMPLEMENTATION-TYPE and
 ;;; LISP-IMPLEMENTATION-VERSION to possibly punt and return NIL, we
 ;;; know that there's no valid reason for our implementations to ever
 ;;; Even though ANSI defines LISP-IMPLEMENTATION-TYPE and
 ;;; LISP-IMPLEMENTATION-VERSION to possibly punt and return NIL, we
 ;;; know that there's no valid reason for our implementations to ever
 ;;;; miscellaneous extensions
 
 (defknown symbol-global-value (symbol) t ())
 ;;;; miscellaneous extensions
 
 (defknown symbol-global-value (symbol) t ())
-(defknown set-symbol-global-value (symbol t) t ())
+(defknown set-symbol-global-value (symbol t) t ()
+  :derive-type #'result-type-last-arg)
 
 (defknown get-bytes-consed () unsigned-byte (flushable))
 (defknown mask-signed-field ((integer 0 *) integer) integer
 
 (defknown get-bytes-consed () unsigned-byte (flushable))
 (defknown mask-signed-field ((integer 0 *) integer) integer
   (movable flushable explicit-check))
 (defknown %instance-typep (t (or type-specifier ctype)) boolean
   (movable flushable explicit-check always-translatable))
   (movable flushable explicit-check))
 (defknown %instance-typep (t (or type-specifier ctype)) boolean
   (movable flushable explicit-check always-translatable))
+;;; We should never emit a call to %typep-wrapper
+(defknown %typep-wrapper (t t (or type-specifier ctype)) t
+  (movable flushable always-translatable))
 
 (defknown %cleanup-point () t)
 (defknown %special-bind (t t) t)
 
 (defknown %cleanup-point () t)
 (defknown %special-bind (t t) t)
 (defknown %check-bound (array index fixnum) index
   (movable foldable flushable dx-safe))
 (defknown data-vector-ref (simple-array index) t
 (defknown %check-bound (array index fixnum) index
   (movable foldable flushable dx-safe))
 (defknown data-vector-ref (simple-array index) t
-  (foldable explicit-check always-translatable))
-(defknown data-vector-ref-with-offset (simple-array index fixnum) t
-  (foldable explicit-check always-translatable))
+  (foldable unsafely-flushable explicit-check always-translatable))
+(defknown data-vector-ref-with-offset (simple-array fixnum fixnum) t
+  (foldable unsafely-flushable explicit-check always-translatable))
 (defknown data-vector-set (array index t) t
   (explicit-check always-translatable))
 (defknown data-vector-set (array index t) t
   (explicit-check always-translatable))
-(defknown data-vector-set-with-offset (array index fixnum t) t
+(defknown data-vector-set-with-offset (array fixnum fixnum t) t
   (explicit-check always-translatable))
 (defknown hairy-data-vector-ref (array index) t
   (foldable explicit-check))
   (explicit-check always-translatable))
 (defknown hairy-data-vector-ref (array index) t
   (foldable explicit-check))
   function
   (flushable foldable))
 
   function
   (flushable foldable))
 
-(defknown %adjoin     (t list)          list (explicit-check foldable flushable))
-(defknown %adjoin-key (t list function) list (explicit-check foldable flushable call))
-(defknown %assoc      (t list)          list (explicit-check foldable flushable))
-(defknown %assoc-key  (t list function) list (explicit-check foldable flushable call))
-(defknown %member     (t list)          list (explicit-check foldable flushable))
-(defknown %member-key (t list function) list (explicit-check foldable flushable call))
-(defknown %rassoc     (t list)          list (explicit-check foldable flushable))
-(defknown %rassoc-key (t list function) list (explicit-check foldable flushable call))
+(defknown (%adjoin %adjoin-eq)
+    (t list)
+    list
+    (explicit-check flushable))
+
+(defknown (%member %member-eq
+           %assoc %assoc-eq %rassoc %rassoc-eq)
+    (t list)
+    list
+    (explicit-check foldable flushable))
+
+(defknown (%adjoin-key %adjoin-key-eq)
+    (t list function)
+    list
+    (explicit-check flushable call))
+
+(defknown (%member-key %member-key-eq
+           %assoc-key %assoc-key-eq %rassoc-key %rassoc-key-eq)
+  (t list function)
+  list
+  (explicit-check foldable flushable call))
+
+(defknown (%assoc-if %assoc-if-not %rassoc-if %rassoc-if-not
+           %member-if %member-if-not)
+  (function list)
+  list
+  (explicit-check foldable flushable call))
+
+(defknown (%assoc-if-key %assoc-if-not-key %rassoc-if-key %rassoc-if-not-key
+           %member-if-key %member-if-not-key)
+  (function list function)
+  list
+  (explicit-check foldable flushable call))
+
+(defknown (%adjoin-test %adjoin-test-not)
+    (t list function)
+    list
+    (explicit-check flushable call))
+
+(defknown (%member-test %member-test-not
+           %assoc-test %assoc-test-not
+           %rassoc-test %rassoc-test-not)
+    (t list function)
+    list
+    (explicit-check foldable flushable call))
+
+(defknown (%adjoin-key-test %adjoin-key-test-not)
+    (t list function function)
+    list
+    (explicit-check flushable call))
+
+(defknown (%member-key-test %member-key-test-not
+           %assoc-key-test %assoc-key-test-not
+           %rassoc-key-test %rassoc-key-test-not)
+    (t list function function)
+    list
+    (explicit-check foldable flushable call))
 
 (defknown %check-vector-sequence-bounds (vector index sequence-end)
   index
 
 (defknown %check-vector-sequence-bounds (vector index sequence-end)
   index
 \f
 ;;;; SETF inverses
 
 \f
 ;;;; SETF inverses
 
-(defknown %aset (array &rest t) t ()
-  :destroyed-constant-args (nth-constant-args 1))
+(defknown (setf aref) (t array &rest index) t ()
+  :destroyed-constant-args (nth-constant-args 2)
+  :derive-type #'result-type-first-arg)
 (defknown %set-row-major-aref (array index t) t ()
   :destroyed-constant-args (nth-constant-args 1))
 (defknown (%rplaca %rplacd) (cons t) t ()
 (defknown %set-row-major-aref (array index t) t ()
   :destroyed-constant-args (nth-constant-args 1))
 (defknown (%rplaca %rplacd) (cons t) t ()
-  :destroyed-constant-args (nth-constant-args 1))
+  :destroyed-constant-args (nth-constant-args 1)
+  :derive-type #'result-type-last-arg)
 (defknown %put (symbol t t) t ())
 (defknown %setelt (sequence index t) t ()
 (defknown %put (symbol t t) t ())
 (defknown %setelt (sequence index t) t ()
-  :destroyed-constant-args (nth-constant-args 1))
+  :destroyed-constant-args (nth-constant-args 1)
+  :derive-type #'result-type-last-arg)
 (defknown %svset (simple-vector index t) t ()
   :destroyed-constant-args (nth-constant-args 1))
 (defknown %svset (simple-vector index t) t ()
   :destroyed-constant-args (nth-constant-args 1))
-(defknown %bitset ((array bit) &rest index) bit ()
-  :destroyed-constant-args (nth-constant-args 1))
-(defknown %sbitset ((simple-array bit) &rest index) bit ()
-  :destroyed-constant-args (nth-constant-args 1))
+(defknown (setf bit) (bit (array bit) &rest index) bit ()
+  :destroyed-constant-args (nth-constant-args 2))
+(defknown (setf sbit) (bit (simple-array bit) &rest index) bit ()
+  :destroyed-constant-args (nth-constant-args 2))
 (defknown %charset (string index character) character ()
   :destroyed-constant-args (nth-constant-args 1))
 (defknown %scharset (simple-string index character) character ()
   :destroyed-constant-args (nth-constant-args 1))
 (defknown %set-symbol-value (symbol t) t ())
 (defknown (setf symbol-function) (function symbol) function ())
 (defknown %charset (string index character) character ()
   :destroyed-constant-args (nth-constant-args 1))
 (defknown %scharset (simple-string index character) character ()
   :destroyed-constant-args (nth-constant-args 1))
 (defknown %set-symbol-value (symbol t) t ())
 (defknown (setf symbol-function) (function symbol) function ())
-(defknown %set-symbol-plist (symbol list) list ())
+(defknown %set-symbol-plist (symbol list) list ()
+  :derive-type #'result-type-last-arg)
 (defknown %setnth (unsigned-byte list t) t ()
 (defknown %setnth (unsigned-byte list t) t ()
-  :destroyed-constant-args (nth-constant-args 2))
+  :destroyed-constant-args (nth-constant-args 2)
+  :derive-type #'result-type-last-arg)
 (defknown %set-fill-pointer (complex-vector index) index
     (explicit-check)
 (defknown %set-fill-pointer (complex-vector index) index
     (explicit-check)
-  :destroyed-constant-args (nth-constant-args 1))
+  :destroyed-constant-args (nth-constant-args 1)
+  :derive-type #'result-type-last-arg)
 \f
 ;;;; ALIEN and call-out-to-C stuff
 
 ;; Used by WITH-PINNED-OBJECTS
 #!+(or x86 x86-64)
 (defknown sb!vm::touch-object (t) (values)
 \f
 ;;;; ALIEN and call-out-to-C stuff
 
 ;; Used by WITH-PINNED-OBJECTS
 #!+(or x86 x86-64)
 (defknown sb!vm::touch-object (t) (values)
-    (always-translatable))
+  (always-translatable))
 
 #!+linkage-table
 (defknown foreign-symbol-dataref-sap (simple-string)
 
 #!+linkage-table
 (defknown foreign-symbol-dataref-sap (simple-string)