X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffndb.lisp;h=eca9eafbba77b623f8f7842a0311c6980fe14424;hb=9769174fc3e1a9d840712a694f61c6051e161cd7;hp=e48440dff5bcba4dd6b36cde5c45ba29dc73b93f;hpb=893dd75069ad851efd19e3d0fa5a4de9e84b4868;p=sbcl.git diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index e48440d..eca9eaf 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -17,24 +17,8 @@ (defknown coerce (t type-specifier) t ;; Note: - ;; (1) This is not FLUSHABLE because it's defined to signal errors. - ;; (2) It's not worth trying to make this FOLDABLE in the - ;; cross-compiler,because - ;; (a) it would probably be really hard to make all the - ;; tricky issues (e.g. which specialized array types are - ;; supported) match between cross-compiler and target - ;; compiler, and besides - ;; (b) leaving it not FOLDABLE lets us use the idiom - ;; (COERCE FOO 'SOME-SPECIALIZED-ARRAY-TYPE-OR-ANOTHER) - ;; as a way of delaying the generation of specialized - ;; array types until runtime, which helps us keep the - ;; cross-compiler's dumper relatively simple and which - ;; lets us preserve distinctions which might not even exist - ;; on the cross-compilation host (because ANSI doesn't - ;; guarantee that specialized array types exist there). - ;; FIXME: It's actually not clear that COERCE on non-NUMBER types - ;; is FOLDABLE at all. Check this. - (movable #-sb-xc-host foldable) + ;; This is not FLUSHABLE because it's defined to signal errors. + (movable) ;; :DERIVE-TYPE RESULT-TYPE-SPEC-NTH-ARG 2 ? Nope... (COERCE 1 'COMPLEX) ;; returns REAL/INTEGER, not COMPLEX. ) @@ -44,8 +28,8 @@ (defknown type-of (t) t (foldable flushable)) ;;; These can be affected by type definitions, so they're not FOLDABLE. -(defknown (upgraded-complex-part-type sb!xc:upgraded-array-element-type) - (type-specifier &optional lexenv-designator) type-specifier +(defknown (sb!xc:upgraded-complex-part-type sb!xc:upgraded-array-element-type) + (type-specifier &optional lexenv-designator) type-specifier (unsafely-flushable)) ;;;; from the "Predicates" chapter: @@ -85,9 +69,9 @@ (unsafely-flushable)) (defknown (null symbolp atom consp listp numberp integerp rationalp floatp - complexp characterp stringp bit-vector-p vectorp - simple-vector-p simple-string-p simple-bit-vector-p arrayp - sb!xc:packagep functionp compiled-function-p not) + complexp characterp stringp bit-vector-p vectorp + simple-vector-p simple-string-p simple-bit-vector-p arrayp + sb!xc:packagep functionp compiled-function-p not) (t) boolean (movable foldable flushable)) (defknown (eq eql) (t t) boolean (movable foldable flushable)) @@ -172,30 +156,30 @@ ;;;; 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 getf (list t &optional t) t (foldable flushable)) (defknown get-properties (list list) (values t t list) (foldable flushable)) (defknown symbol-name (symbol) simple-string (movable foldable flushable)) (defknown make-symbol (string) symbol (flushable)) +(defknown %make-symbol (simple-string) symbol (flushable)) (defknown copy-symbol (symbol &optional t) symbol (flushable)) (defknown gensym (&optional (or string unsigned-byte)) symbol ()) (defknown symbol-package (symbol) (or sb!xc:package null) (flushable)) -(defknown keywordp (t) boolean (flushable)) ; If someone uninterns it... +(defknown keywordp (t) boolean (flushable)) ; If someone uninterns it... ;;;; from the "Packages" chapter: -(sb!xc:deftype package-designator () '(or stringable sb!xc:package)) -(sb!xc:deftype symbols () '(or list symbol)) - (defknown gentemp (&optional string package-designator) symbol) -(defknown make-package (stringable &key - (:use list) - (:nicknames list) - ;; ### extensions... - (:internal-symbols index) - (:external-symbols index)) +(defknown make-package (string-designator &key + (:use list) + (:nicknames list) + ;; ### extensions... + (:internal-symbols index) + (:external-symbols index)) sb!xc:package) (defknown find-package (package-designator) (or sb!xc:package null) (flushable)) @@ -214,15 +198,17 @@ (defknown find-symbol (string &optional package-designator) (values symbol (member :internal :external :inherited nil)) (flushable)) -(defknown (export import) (symbols &optional package-designator) (eql t)) +(defknown (export import) (symbols-designator &optional package-designator) + (eql t)) (defknown unintern (symbol &optional package-designator) boolean) -(defknown unexport (symbols &optional package-designator) (eql t)) -(defknown shadowing-import (symbols &optional package-designator) (eql t)) -(defknown shadow ((or symbol string list) &optional package-designator) +(defknown unexport (symbols-designator &optional package-designator) (eql t)) +(defknown shadowing-import (symbols-designator &optional package-designator) + (eql t)) +(defknown shadow ((or symbol character string list) &optional package-designator) (eql t)) (defknown (use-package unuse-package) ((or list package-designator) &optional package-designator) (eql t)) -(defknown find-all-symbols (stringable) list (flushable)) +(defknown find-all-symbols (string-designator) list (flushable)) ;;;; from the "Numbers" chapter: @@ -245,7 +231,7 @@ (defknown * (&rest number) number (movable foldable flushable explicit-check)) (defknown / (number &rest number) number - (movable foldable flushable explicit-check)) + (movable foldable unsafely-flushable explicit-check)) (defknown (1+ 1-) (number) number (movable foldable flushable explicit-check)) @@ -336,22 +322,22 @@ (movable foldable flushable explicit-check)) (defknown (ffloor fceiling fround ftruncate) - (real &optional real) (values float float) + (real &optional real) (values float real) (movable foldable flushable explicit-check)) (defknown decode-float (float) (values float float-exponent float) (movable foldable flushable explicit-check)) -(defknown scale-float (float float-exponent) float - (movable foldable flushable explicit-check)) +(defknown scale-float (float integer) float + (movable foldable unsafely-flushable explicit-check)) (defknown float-radix (float) float-radix - (movable foldable flushable explicit-check)) + (movable foldable flushable)) (defknown float-sign (float &optional float) float (movable foldable flushable explicit-check)) (defknown (float-digits float-precision) (float) float-digits (movable foldable flushable explicit-check)) (defknown integer-decode-float (float) - (values integer float-exponent (member -1 1)) - (movable foldable flushable explicit-check)) + (values integer float-int-exponent (member -1 1)) + (movable foldable flushable explicit-check)) (defknown complex (real &optional real) number (movable foldable flushable explicit-check)) @@ -362,7 +348,7 @@ (movable foldable flushable explicit-check)) (defknown (lognand lognor logandc1 logandc2 logorc1 logorc2) - (integer integer) integer + (integer integer) integer (movable foldable flushable explicit-check)) (defknown boole (boole-code integer integer) integer @@ -370,7 +356,7 @@ (defknown lognot (integer) integer (movable foldable flushable explicit-check)) (defknown logtest (integer integer) boolean (movable foldable flushable)) -(defknown logbitp (bit-index integer) boolean (movable foldable flushable)) +(defknown logbitp (unsigned-byte integer) boolean (movable foldable flushable)) (defknown ash (integer integer) integer (movable foldable flushable explicit-check)) (defknown (logcount integer-length) (integer) bit-index @@ -393,21 +379,22 @@ (movable foldable flushable)) (defknown deposit-field (integer byte-specifier integer) integer (movable foldable flushable)) -(defknown random ((real (0)) &optional random-state) (real 0) ()) +(defknown random ((or (float (0.0)) (integer 1)) &optional random-state) + (or (float 0.0) (integer 0)) ()) (defknown make-random-state (&optional (or (member nil t) random-state)) random-state (flushable)) (defknown random-state-p (t) boolean (movable foldable flushable)) ;;;; from the "Characters" chapter: (defknown (standard-char-p graphic-char-p alpha-char-p - upper-case-p lower-case-p both-case-p alphanumericp) + upper-case-p lower-case-p both-case-p alphanumericp) (character) boolean (movable foldable flushable)) (defknown digit-char-p (character &optional (integer 2 36)) (or (integer 0 35) null) (movable foldable flushable)) (defknown (char= char/= char< char> char<= char>= char-equal char-not-equal - char-lessp char-greaterp char-not-greaterp char-not-lessp) + char-lessp char-greaterp char-not-greaterp char-not-lessp) (character &rest character) boolean (movable foldable flushable)) (defknown character (t) character (movable foldable unsafely-flushable)) @@ -419,9 +406,9 @@ (defknown char-int (character) char-code (movable foldable flushable)) (defknown char-name (character) (or simple-string null) (movable foldable flushable)) -(defknown name-char (stringable) (or character null) +(defknown name-char (string-designator) (or character null) (movable foldable flushable)) -(defknown code-char (char-code) base-char +(defknown code-char (char-code) character ;; By suppressing constant folding on CODE-CHAR when the ;; cross-compiler is running in the cross-compilation host vanilla ;; ANSI Common Lisp, we can use CODE-CHAR expressions to delay until @@ -447,19 +434,20 @@ (defknown reverse (sequence) consed-sequence (flushable) :derive-type (sequence-result-nth-arg 1)) -(defknown nreverse (sequence) sequence () - :derive-type #'result-type-first-arg) +(defknown nreverse (sequence) sequence (important-result) + :derive-type #'result-type-first-arg + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown make-sequence (type-specifier index - &key - (:initial-element t)) + &key + (:initial-element t)) consed-sequence (movable unsafe) - :derive-type (result-type-specifier-nth-arg 1)) + :derive-type (creation-result-type-specifier-nth-arg 1)) (defknown concatenate (type-specifier &rest sequence) consed-sequence () - :derive-type (result-type-specifier-nth-arg 1)) + :derive-type (creation-result-type-specifier-nth-arg 1)) (defknown (map %map) (type-specifier callable sequence &rest sequence) consed-sequence @@ -477,7 +465,8 @@ (defknown map-into (sequence callable &rest sequence) sequence (call) - :derive-type #'result-type-first-arg) + :derive-type #'result-type-first-arg + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) ;;; returns the result from the predicate... (defknown some (callable sequence &rest sequence) t @@ -487,33 +476,25 @@ (foldable unsafely-flushable call)) ;;; unsafe for :INITIAL-VALUE... -(defknown reduce (callable - sequence - &key - (:from-end t) - (:start index) - (:end sequence-end) - (:initial-value t) - (:key callable)) +(defknown reduce (callable sequence &rest t &key (:from-end t) (:start index) + (:end sequence-end) (:initial-value t) (:key callable)) t (foldable flushable call unsafe)) -(defknown fill (sequence t &key (:start index) (:end sequence-end)) sequence +(defknown fill (sequence t &rest t &key + (:start index) (:end sequence-end)) sequence (unsafe) - :derive-type #'result-type-first-arg) + :derive-type #'result-type-first-arg + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) -(defknown replace (sequence - sequence - &key - (:start1 index) - (:end1 sequence-end) - (:start2 index) - (:end2 sequence-end)) +(defknown replace (sequence sequence &rest t &key (:start1 index) + (:end1 sequence-end) (:start2 index) (:end2 sequence-end)) sequence () - :derive-type #'result-type-first-arg) + :derive-type #'result-type-first-arg + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown remove - (t sequence &key (:from-end t) (:test callable) + (t sequence &rest t &key (:from-end t) (:test callable) (:test-not callable) (:start index) (:end sequence-end) (:count sequence-count) (:key callable)) consed-sequence @@ -521,7 +502,7 @@ :derive-type (sequence-result-nth-arg 2)) (defknown substitute - (t t sequence &key (:from-end t) (:test callable) + (t t sequence &rest t &key (:from-end t) (:test callable) (:test-not callable) (:start index) (:end sequence-end) (:count sequence-count) (:key callable)) consed-sequence @@ -529,133 +510,144 @@ :derive-type (sequence-result-nth-arg 3)) (defknown (remove-if remove-if-not) - (callable sequence &key (:from-end t) (:start index) (:end sequence-end) - (:count sequence-count) (:key callable)) + (callable sequence &rest t &key (:from-end t) (:start index) + (:end sequence-end) (:count sequence-count) (:key callable)) consed-sequence (flushable call) :derive-type (sequence-result-nth-arg 2)) (defknown (substitute-if substitute-if-not) - (t callable sequence &key (:from-end t) (:start index) (:end sequence-end) - (:count sequence-count) (:key callable)) + (t callable sequence &rest t &key (:from-end t) (:start index) + (:end sequence-end) (:count sequence-count) (:key callable)) consed-sequence (flushable call) :derive-type (sequence-result-nth-arg 3)) (defknown delete - (t sequence &key (:from-end t) (:test callable) + (t sequence &rest t &key (:from-end t) (:test callable) (:test-not callable) (:start index) (:end sequence-end) (:count sequence-count) (:key callable)) sequence - (flushable call) - :derive-type (sequence-result-nth-arg 2)) + (flushable call important-result) + :derive-type (sequence-result-nth-arg 2) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)) (defknown nsubstitute - (t t sequence &key (:from-end t) (:test callable) + (t t sequence &rest t &key (:from-end t) (:test callable) (:test-not callable) (:start index) (:end sequence-end) (:count sequence-count) (:key callable)) sequence (flushable call) - :derive-type (sequence-result-nth-arg 3)) + :derive-type (sequence-result-nth-arg 3) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 3)) (defknown (delete-if delete-if-not) - (callable sequence &key (:from-end t) (:start index) (:end sequence-end) - (:count sequence-count) (:key callable)) + (callable sequence &rest t &key (:from-end t) (:start index) + (:end sequence-end) (:count sequence-count) (:key callable)) sequence - (flushable call) - :derive-type (sequence-result-nth-arg 2)) + (flushable call important-result) + :derive-type (sequence-result-nth-arg 2) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)) (defknown (nsubstitute-if nsubstitute-if-not) - (t callable sequence &key (:from-end t) (:start index) (:end sequence-end) - (:count sequence-count) (:key callable)) + (t callable sequence &rest t &key (:from-end t) (:start index) + (:end sequence-end) (:count sequence-count) (:key callable)) sequence (flushable call) - :derive-type (sequence-result-nth-arg 3)) + :derive-type (sequence-result-nth-arg 3) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 3)) (defknown remove-duplicates - (sequence &key (:test callable) (:test-not callable) (:start index) - (:from-end t) (:end sequence-end) (:key callable)) + (sequence &rest t &key (:test callable) (:test-not callable) (:start index) + (:from-end t) (:end sequence-end) (:key callable)) consed-sequence (unsafely-flushable call) :derive-type (sequence-result-nth-arg 1)) (defknown delete-duplicates - (sequence &key (:test callable) (:test-not callable) (:start index) - (:from-end t) (:end sequence-end) (:key callable)) + (sequence &rest t &key (:test callable) (:test-not callable) (:start index) + (:from-end t) (:end sequence-end) (:key callable)) sequence - (unsafely-flushable call) - :derive-type (sequence-result-nth-arg 1)) + (unsafely-flushable call important-result) + :derive-type (sequence-result-nth-arg 1) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) -(defknown find (t sequence &key (:test callable) (:test-not callable) - (:start index) (:from-end t) (:end sequence-end) - (:key callable)) +(defknown find (t sequence &rest t &key (:test callable) + (:test-not callable) (:start index) (:from-end t) + (:end sequence-end) (:key callable)) t (foldable flushable call)) (defknown (find-if find-if-not) - (callable sequence &key (:from-end t) (:start index) (:end sequence-end) - (:key callable)) + (callable sequence &rest t &key (:from-end t) (:start index) + (:end sequence-end) (:key callable)) t (foldable flushable call)) -(defknown position (t sequence &key (:test callable) (:test-not callable) - (:start index) (:from-end t) (:end sequence-end) - (:key callable)) +(defknown position (t sequence &rest t &key (:test callable) + (:test-not callable) (:start index) (:from-end t) + (:end sequence-end) (:key callable)) (or index null) (foldable flushable call)) (defknown (position-if position-if-not) - (callable sequence &key (:from-end t) (:start index) (:end sequence-end) - (:key callable)) + (callable sequence &rest t &key (:from-end t) (:start index) + (:end sequence-end) (:key callable)) (or index null) (foldable flushable call)) -(defknown count (t sequence &key (:test callable) (:test-not callable) - (:start index) (:from-end t) (:end sequence-end) - (:key callable)) +(defknown count (t sequence &rest t &key + (:test callable) (:test-not callable) (:start index) + (:from-end t) (:end sequence-end) (:key callable)) index (foldable flushable call)) (defknown (count-if count-if-not) - (callable sequence &key (:from-end t) (:start index) (:end sequence-end) - (:key callable)) + (callable sequence &rest t &key + (:from-end t) (:start index) (:end sequence-end) (:key callable)) index (foldable flushable call)) (defknown (mismatch search) - (sequence sequence &key (:from-end t) (:test callable) (:test-not callable) - (:start1 index) (:end1 sequence-end) - (:start2 index) (:end2 sequence-end) - (:key callable)) + (sequence sequence &rest t &key (:from-end t) (:test callable) + (:test-not callable) (:start1 index) (:end1 sequence-end) + (:start2 index) (:end2 sequence-end) (:key callable)) (or index null) (foldable flushable call)) ;;; not FLUSHABLE, since vector sort guaranteed in-place... -(defknown (stable-sort sort) (sequence callable &key (:key callable)) sequence +(defknown (stable-sort sort) (sequence callable &rest t &key (:key callable)) + sequence (call) - :derive-type (sequence-result-nth-arg 1)) + :derive-type (sequence-result-nth-arg 1) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) +(defknown sb!impl::stable-sort-list (list function function) list + (call important-result) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown sb!impl::sort-vector (vector index index function (or function null)) * ; SORT-VECTOR works through side-effect - (call)) + (call) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown merge (type-specifier sequence sequence callable - &key (:key callable)) + &key (:key callable)) sequence - (call) - :derive-type (result-type-specifier-nth-arg 1)) + (call important-result) + :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) - (:end sequence-end)) + &key + (:start index) + (:end sequence-end)) (index) ()) (defknown write-sequence (sequence stream - &key - (:start index) - (:end sequence-end)) + &key + (:start index) + (:end sequence-end)) sequence () :derive-type (sequence-result-nth-arg 1)) @@ -684,9 +676,10 @@ (foldable flushable call)) (defknown endp (list) boolean (foldable flushable movable)) (defknown list-length (list) (or index null) (foldable unsafely-flushable)) -(defknown nth (index list) t (foldable flushable)) -(defknown nthcdr (index list) t (foldable unsafely-flushable)) -(defknown last (list &optional index) t (foldable flushable)) +(defknown nth (unsigned-byte list) t (foldable flushable)) +(defknown nthcdr (unsigned-byte list) t (foldable unsafely-flushable)) +(defknown last (list &optional unsigned-byte) t (foldable flushable)) +(defknown sb!impl::last1 (list) t (foldable flushable)) (defknown list (&rest t) list (movable flushable unsafe)) (defknown list* (t &rest t) t (movable flushable unsafe)) (defknown make-list (index &key (:initial-element t)) list @@ -704,28 +697,47 @@ ;;; All but last must be of type LIST, but there seems to be no way to ;;; express that in this syntax. The result must be LIST, but we do ;;; not check it now :-). -(defknown nconc (&rest t) t ()) +(defknown nconc (&rest t) t () + :destroyed-constant-args (remove-non-constants-and-nils #'butlast)) +(defknown sb!impl::nconc2 (list t) t () + :destroyed-constant-args (remove-non-constants-and-nils #'butlast)) + +(defknown nreconc (list t) t (important-result) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) +(defknown butlast (list &optional unsigned-byte) list (flushable)) +(defknown nbutlast (list &optional unsigned-byte) list () + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) -(defknown nreconc (list t) t ()) -(defknown butlast (list &optional index) list (flushable)) -(defknown nbutlast (list &optional index) list ()) (defknown ldiff (list t) list (flushable)) -(defknown (rplaca rplacd) (cons t) list (unsafe)) +(defknown (rplaca rplacd) (cons t) list (unsafe) + :destroyed-constant-args (nth-constant-args 1)) -(defknown (nsubst subst) (t t t &key (:key callable) (:test callable) - (:test-not callable)) +(defknown subst (t t t &key (:key callable) (:test callable) + (:test-not callable)) t (flushable unsafe call)) +(defknown nsubst (t t t &key (:key callable) (:test callable) + (:test-not callable)) + t (unsafe call) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 3)) -(defknown (subst-if subst-if-not nsubst-if nsubst-if-not) - (t callable t &key (:key callable)) +(defknown (subst-if subst-if-not) + (t callable t &key (:key callable)) t (flushable unsafe call)) +(defknown (nsubst-if nsubst-if-not) + (t callable t &key (:key callable)) + t (unsafe call) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 3)) -(defknown (sublis nsublis) (list t &key (:key callable) (:test callable) - (:test-not callable)) +(defknown sublis (list t &key (:key callable) (:test callable) + (:test-not callable)) t (flushable unsafe call)) +(defknown nsublis (list t &key (:key callable) (:test callable) + (:test-not callable)) + t (flushable unsafe call) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)) (defknown member (t list &key (:key callable) (:test callable) - (:test-not callable)) + (:test-not callable)) list (foldable flushable call)) (defknown (member-if member-if-not) (callable list &key (:key callable)) list (foldable flushable call)) @@ -733,7 +745,7 @@ (defknown tailp (t list) boolean (foldable flushable)) (defknown adjoin (t list &key (:key callable) (:test callable) - (:test-not callable)) + (:test-not callable)) list (foldable flushable unsafe call)) (defknown (union intersection set-difference set-exclusive-or) @@ -744,7 +756,8 @@ (defknown (nunion nintersection nset-difference nset-exclusive-or) (list list &key (:key callable) (:test callable) (:test-not callable)) list - (foldable flushable call)) + (foldable flushable call important-result) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1 2)) (defknown subsetp (list list &key (:key callable) (:test callable) (:test-not callable)) @@ -755,13 +768,14 @@ (defknown pairlis (t t &optional t) list (flushable unsafe)) (defknown (rassoc assoc) - (t list &key (:key callable) (:test callable) (:test-not callable)) + (t list &key (:key callable) (:test callable) (:test-not callable)) list (foldable flushable call)) (defknown (assoc-if-not assoc-if rassoc-if rassoc-if-not) - (callable list &key (:key callable)) list (foldable flushable call)) + (callable list &key (:key callable)) list (foldable flushable call)) (defknown (memq assq) (t list) list (foldable flushable unsafe)) -(defknown delq (t list) list (flushable unsafe)) +(defknown delq (t list) list (flushable unsafe) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)) ;;;; from the "Hash Tables" chapter: @@ -769,16 +783,23 @@ (&key (:test callable) (:size unsigned-byte) (:rehash-size (or (integer 1) (float (1.0)))) (:rehash-threshold (real 0 1)) - (:weak-p t)) + (:weakness (member nil :key :value :key-and-value :key-or-value))) hash-table (flushable unsafe)) (defknown hash-table-p (t) boolean (movable foldable flushable)) (defknown gethash (t hash-table &optional t) (values t boolean) (flushable unsafe)) ; not FOLDABLE, since hash table contents can change -(defknown %puthash (t hash-table t) t (unsafe)) -(defknown remhash (t hash-table) boolean ()) +(defknown sb!impl::gethash2 (t hash-table) (values t boolean) + (flushable unsafe)) ; not FOLDABLE, since hash table contents can change +(defknown sb!impl::gethash3 (t hash-table t) (values t boolean) + (flushable unsafe)) ; not FOLDABLE, since hash table contents can change +(defknown %puthash (t hash-table t) t (unsafe) + :destroyed-constant-args (nth-constant-args 2)) +(defknown remhash (t hash-table) boolean () + :destroyed-constant-args (nth-constant-args 2)) (defknown maphash (callable hash-table) null (flushable call)) -(defknown clrhash (hash-table) hash-table ()) +(defknown clrhash (hash-table) hash-table () + :destroyed-constant-args (nth-constant-args 2)) (defknown hash-table-count (hash-table) index (flushable)) (defknown hash-table-rehash-size (hash-table) (or (integer 1) (float (1.0))) (foldable flushable)) @@ -787,19 +808,21 @@ (defknown hash-table-size (hash-table) index (flushable)) (defknown hash-table-test (hash-table) symbol (foldable flushable)) (defknown sxhash (t) (integer 0 #.sb!xc:most-positive-fixnum) - (foldable flushable)) + (#-sb-xc-host foldable flushable)) +(defknown psxhash (t &optional t) (integer 0 #.sb!xc:most-positive-fixnum) + (#-sb-xc-host foldable flushable)) ;;;; from the "Arrays" chapter (defknown make-array ((or index list) - &key - (:element-type type-specifier) - (:initial-element t) - (:initial-contents t) - (:adjustable t) - (:fill-pointer t) - (:displaced-to (or array null)) - (:displaced-index-offset index)) + &key + (:element-type type-specifier) + (:initial-element t) + (:initial-contents t) + (:adjustable t) + (:fill-pointer t) + (:displaced-to (or array null)) + (:displaced-index-offset index)) array (flushable unsafe)) (defknown vector (&rest t) simple-vector (flushable unsafe)) @@ -823,16 +846,17 @@ (defknown bit ((array bit) &rest index) bit (foldable flushable)) (defknown sbit ((simple-array bit) &rest index) bit (foldable flushable)) +;;; FIXME: :DESTROYED-CONSTANT-ARGS for these is complicated. (defknown (bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1 bit-andc2 - bit-orc1 bit-orc2) + bit-orc1 bit-orc2) ((array bit) (array bit) &optional (or (array bit) (member t nil))) (array bit) - (foldable) + () #|:derive-type #'result-type-last-arg|#) (defknown bit-not ((array bit) &optional (or (array bit) (member t nil))) (array bit) - (foldable) + () #|:derive-type #'result-type-last-arg|#) (defknown bit-vector-= (bit-vector bit-vector) boolean @@ -841,15 +865,21 @@ (defknown array-has-fill-pointer-p (array) boolean (movable foldable flushable)) (defknown fill-pointer (vector) index (foldable unsafely-flushable)) -(defknown vector-push (t vector) (or index null) ()) -(defknown vector-push-extend (t vector &optional index) index ()) -(defknown vector-pop (vector) t ()) - +(defknown vector-push (t vector) (or index null) () + :destroyed-constant-args (nth-constant-args 2)) +(defknown vector-push-extend (t vector &optional index) index () + :destroyed-constant-args (nth-constant-args 2)) +(defknown vector-pop (vector) t () + :destroyed-constant-args (nth-constant-args 1)) + +;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS +;;; Also, an important-result warning could be provided if the array +;;; is known to be not expressly adjustable. (defknown adjust-array (array (or index list) &key (:element-type type-specifier) - (:initial-element t) (:initial-contents t) - (:fill-pointer t) (:displaced-to (or array null)) - (:displaced-index-offset index)) + (:initial-element t) (:initial-contents t) + (:fill-pointer t) (:displaced-to (or array null)) + (:displaced-index-offset index)) array (unsafe)) ; :derive-type 'result-type-arg1) Not even close... @@ -858,49 +888,48 @@ (defknown char (string index) character (foldable flushable)) (defknown schar (simple-string index) character (foldable flushable)) -(sb!xc:deftype stringable () '(or character string symbol)) - (defknown (string= string-equal) - (stringable stringable &key (:start1 index) (:end1 sequence-end) - (:start2 index) (:end2 sequence-end)) + (string-designator string-designator &key (:start1 index) (:end1 sequence-end) + (:start2 index) (:end2 sequence-end)) boolean (foldable flushable)) (defknown (string< string> string<= string>= string/= string-lessp - string-greaterp string-not-lessp string-not-greaterp - string-not-equal) - (stringable stringable &key (:start1 index) (:end1 sequence-end) - (:start2 index) (:end2 sequence-end)) + string-greaterp string-not-lessp string-not-greaterp + string-not-equal) + (string-designator string-designator &key (:start1 index) (:end1 sequence-end) + (:start2 index) (:end2 sequence-end)) (or index null) (foldable flushable)) (defknown make-string (index &key (:element-type type-specifier) - (:initial-element character)) + (:initial-element character)) simple-string (flushable)) (defknown (string-trim string-left-trim string-right-trim) - (sequence stringable) simple-string (flushable)) + (sequence string-designator) simple-string (flushable)) (defknown (string-upcase string-downcase string-capitalize) - (stringable &key (:start index) (:end sequence-end)) + (string-designator &key (:start index) (:end sequence-end)) simple-string (flushable)) (defknown (nstring-upcase nstring-downcase nstring-capitalize) (string &key (:start index) (:end sequence-end)) - string ()) + string () + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) -(defknown string (stringable) string +(defknown string (string-designator) string (flushable explicit-check)) ;;;; internal non-keyword versions of string predicates: (defknown (string<* string>* string<=* string>=* string/=*) - (stringable stringable index sequence-end index sequence-end) + (string-designator string-designator index sequence-end index sequence-end) (or index null) (foldable flushable)) (defknown string=* - (stringable stringable index sequence-end index sequence-end) + (string-designator string-designator index sequence-end index sequence-end) boolean (foldable flushable)) @@ -917,9 +946,13 @@ (defknown make-concatenated-stream (&rest stream) stream (unsafely-flushable)) (defknown make-two-way-stream (stream stream) stream (unsafely-flushable)) (defknown make-echo-stream (stream stream) stream (flushable)) -(defknown make-string-input-stream (string &optional index index) stream +(defknown make-string-input-stream (string &optional index sequence-end) + stream (flushable unsafe)) -(defknown make-string-output-stream () stream (flushable)) +(defknown make-string-output-stream + (&key (:element-type type-specifier)) + stream + (flushable)) (defknown get-output-stream-string (stream) simple-string ()) (defknown streamp (t) boolean (movable foldable flushable)) (defknown stream-element-type (stream) type-specifier @@ -940,7 +973,7 @@ (defknown readtablep (t) boolean (movable foldable flushable)) (defknown set-syntax-from-char - (character character &optional (or readtable null) readtable) (eql t) + (character character &optional readtable (or readtable null)) (eql t) ()) (defknown set-macro-character (character callable &optional t readtable) @@ -958,43 +991,79 @@ (character character &optional (or readtable null)) (or callable null) ()) +(defknown copy-pprint-dispatch + (&optional (or sb!pretty:pprint-dispatch-table null)) + sb!pretty:pprint-dispatch-table + ()) +(defknown pprint-dispatch + (t &optional (or sb!pretty:pprint-dispatch-table null)) + (values callable boolean) + ()) +(defknown (pprint-fill pprint-linear) + (stream-designator t &optional t t) + null + ()) +(defknown pprint-tabular + (stream-designator t &optional t t unsigned-byte) + null + ()) +(defknown pprint-indent + ((member :block :current) real &optional stream-designator) + null + ()) +(defknown pprint-newline + ((member :linear :fill :miser :mandatory) &optional stream-designator) + null + ()) +(defknown pprint-tab + ((member :line :section :line-relative :section-relative) + unsigned-byte unsigned-byte &optional stream-designator) + null + ()) +(defknown set-pprint-dispatch + (type-specifier (or null callable) + &optional real sb!pretty:pprint-dispatch-table) + null + ()) + ;;; may return any type due to eof-value... (defknown (read read-preserving-whitespace read-char-no-hang read-char) - (&optional streamlike t t t) t (explicit-check)) + (&optional stream-designator t t t) t (explicit-check)) -(defknown read-delimited-list (character &optional streamlike t) list +(defknown read-delimited-list (character &optional stream-designator t) list (explicit-check)) -(defknown read-line (&optional streamlike t t t) (values t boolean) +(defknown read-line (&optional stream-designator t t t) (values t boolean) (explicit-check)) -(defknown unread-char (character &optional streamlike) t +(defknown unread-char (character &optional stream-designator) t (explicit-check)) -(defknown peek-char (&optional (or character (member nil t)) streamlike t t t) +(defknown peek-char (&optional (or character (member nil t)) + stream-designator t t t) t (explicit-check)) -(defknown listen (&optional streamlike) boolean (flushable explicit-check)) +(defknown listen (&optional stream-designator) boolean (flushable explicit-check)) -(defknown clear-input (&optional stream) null (explicit-check)) +(defknown clear-input (&optional stream-designator) null (explicit-check)) (defknown read-from-string (string &optional t t - &key - (:start index) - (:end sequence-end) - (:preserve-whitespace t)) + &key + (:start index) + (:end sequence-end) + (:preserve-whitespace t)) (values t index)) (defknown parse-integer (string &key - (:start index) - (:end sequence-end) - (:radix (integer 2 36)) - (:junk-allowed t)) + (:start index) + (:end sequence-end) + (:radix (integer 2 36)) + (:junk-allowed t)) (values (or integer null ()) index)) (defknown read-byte (stream &optional t t) t (explicit-check)) (defknown write (t &key - (:stream streamlike) + (:stream stream-designator) (:escape t) (:radix t) (:base (integer 2 36)) @@ -1014,11 +1083,14 @@ (any explicit-check) :derive-type #'result-type-first-arg) -(defknown (prin1 print princ) (t &optional streamlike) t (any explicit-check) +(defknown (prin1 print princ) (t &optional stream-designator) + t + (any explicit-check) :derive-type #'result-type-first-arg) ;;; xxx-TO-STRING functions are not foldable because they depend on -;;; the dynamic environment. +;;; the dynamic environment, the state of the pretty printer dispatch +;;; table, and probably other run-time factors. (defknown write-to-string (t &key (:escape t) (:radix t) (:base (integer 2 36)) (:readably t) (:circle t) (:pretty t) (:level (or unsigned-byte null)) @@ -1026,28 +1098,30 @@ (:lines (or unsigned-byte null)) (:right-margin (or unsigned-byte null)) (:miser-width (or unsigned-byte null)) (:pprint-dispatch t)) simple-string - (foldable flushable explicit-check)) + (flushable explicit-check)) (defknown (prin1-to-string princ-to-string) (t) simple-string (flushable)) -(defknown write-char (character &optional streamlike) character +(defknown write-char (character &optional stream-designator) character (explicit-check)) (defknown (write-string write-line) - (string &optional streamlike &key (:start index) (:end sequence-end)) + (string &optional stream-designator &key (:start index) (:end sequence-end)) string (explicit-check)) (defknown (terpri finish-output force-output clear-output) - (&optional streamlike) null + (&optional stream-designator) null (explicit-check)) -(defknown fresh-line (&optional streamlike) boolean +(defknown fresh-line (&optional stream-designator) boolean (explicit-check)) (defknown write-byte (integer stream) integer (explicit-check)) -(defknown format ((or streamlike string) (or string function) &rest t) +;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS +(defknown format ((or (member nil t) stream string) + (or string function) &rest t) (or string null) (explicit-check)) @@ -1062,18 +1136,18 @@ ;;; parsing of a PATHNAME-DESIGNATOR might signal an error.) (defknown wild-pathname-p (pathname-designator - &optional - (member nil :host :device - :directory :name - :type :version)) + &optional + (member nil :host :device + :directory :name + :type :version)) generalized-boolean ()) (defknown pathname-match-p (pathname-designator pathname-designator) generalized-boolean ()) (defknown translate-pathname (pathname-designator - pathname-designator - pathname-designator &key) + pathname-designator + pathname-designator &key) pathname ()) @@ -1083,24 +1157,24 @@ (defknown load-logical-pathname-translations (string) t ()) (defknown logical-pathname-translations (logical-host-designator) list ()) -(defknown pathname (pathname-designator) pathname (unsafely-flushable)) +(defknown pathname (pathname-designator) pathname ()) (defknown truename (pathname-designator) pathname ()) (defknown parse-namestring (pathname-designator &optional (or list host string (member :unspecific)) pathname-designator - &key - (:start index) - (:end sequence-end) - (:junk-allowed t)) + &key + (:start index) + (:end sequence-end) + (:junk-allowed t)) (values (or pathname null) sequence-end) ()) (defknown merge-pathnames (pathname-designator &optional pathname-designator pathname-version) pathname - (unsafely-flushable)) + ()) (defknown make-pathname (&key (:defaults pathname-designator) @@ -1115,19 +1189,19 @@ (defknown pathnamep (t) boolean (movable flushable)) (defknown pathname-host (pathname-designator - &key (:case (member :local :common))) + &key (:case (member :local :common))) pathname-host (flushable)) (defknown pathname-device (pathname-designator - &key (:case (member :local :common))) + &key (:case (member :local :common))) pathname-device (flushable)) (defknown pathname-directory (pathname-designator - &key (:case (member :local :common))) + &key (:case (member :local :common))) pathname-directory (flushable)) (defknown pathname-name (pathname-designator - &key (:case (member :local :common))) + &key (:case (member :local :common))) pathname-name (flushable)) (defknown pathname-type (pathname-designator - &key (:case (member :local :common))) + &key (:case (member :local :common))) pathname-type (flushable)) (defknown pathname-version (pathname-designator) pathname-version (flushable)) @@ -1144,13 +1218,13 @@ (defknown open (pathname-designator &key - (:direction (member :input :output :io :probe)) - (:element-type type-specifier) - (:if-exists (member :error :new-version :rename - :rename-and-delete :overwrite - :append :supersede nil)) - (:if-does-not-exist (member :error :create nil)) - (:external-format (member :default))) + (:direction (member :input :output :io :probe)) + (:element-type type-specifier) + (:if-exists (member :error :new-version :rename + :rename-and-delete :overwrite + :append :supersede nil)) + (:if-does-not-exist (member :error :create nil)) + (:external-format keyword)) (or stream null)) (defknown rename-file (pathname-designator filename) @@ -1163,7 +1237,7 @@ ()) (defknown file-position (stream &optional - (or unsigned-byte (member :start :end))) + (or unsigned-byte (member :start :end))) (or unsigned-byte (member t nil))) (defknown file-length (stream) (or unsigned-byte null) (unsafely-flushable)) @@ -1173,7 +1247,7 @@ (:verbose t) (:print t) (:if-does-not-exist (member :error :create nil)) - (:external-format (member :default))) + (:external-format keyword)) t) (defknown directory (pathname-designator &key) @@ -1215,17 +1289,17 @@ (values (or function symbol cons) boolean boolean)) (defknown compile-file - (filename + (pathname-designator &key ;; ANSI options - (:output-file (or filename - null - ;; FIXME: This last case is a non-ANSI hack. - (member t))) + (:output-file (or pathname-designator + null + ;; FIXME: This last case is a non-ANSI hack. + (member t))) (:verbose t) (:print t) - (:external-format t) + (:external-format keyword) ;; extensions (:trace-file t) @@ -1235,7 +1309,7 @@ ;; FIXME: consider making (OR CALLABLE CONS) something like ;; EXTENDED-FUNCTION-DESIGNATOR (defknown disassemble ((or callable cons) &key - (:stream stream) (:use-labels t)) + (:stream stream) (:use-labels t)) null) (defknown fdocumentation (t symbol) @@ -1245,25 +1319,25 @@ (defknown describe (t &optional (or stream (member t nil))) (values)) (defknown inspect (t) (values)) (defknown room (&optional (member t nil :default)) (values)) -(defknown ed (&optional (or symbol cons filename) &key (:init t) (:display t)) +(defknown ed (&optional (or symbol cons filename)) t) (defknown dribble (&optional filename &key (:if-exists t)) (values)) -(defknown apropos (stringable &optional package-designator t) (values)) -(defknown apropos-list (stringable &optional package-designator t) list +(defknown apropos (string-designator &optional package-designator t) (values)) +(defknown apropos-list (string-designator &optional package-designator t) list (flushable)) (defknown get-decoded-time () (values (integer 0 59) (integer 0 59) (integer 0 23) (integer 1 31) - (integer 1 12) unsigned-byte (integer 0 6) boolean (rational -24 24)) + (integer 1 12) unsigned-byte (integer 0 6) boolean (rational -24 24)) (flushable)) (defknown get-universal-time () unsigned-byte (flushable)) (defknown decode-universal-time - (unsigned-byte &optional (or null (rational -24 24))) + (unsigned-byte &optional (or null (rational -24 24))) (values (integer 0 59) (integer 0 59) (integer 0 23) (integer 1 31) - (integer 1 12) unsigned-byte (integer 0 6) boolean (rational -24 24)) + (integer 1 12) unsigned-byte (integer 0 6) boolean (rational -24 24)) (flushable)) (defknown encode-universal-time @@ -1288,8 +1362,8 @@ ;;; available, so -- unlike the related LISP-IMPLEMENTATION-FOO ;;; functions -- these really can return NIL. (defknown (machine-type machine-version machine-instance - software-type software-version - short-site-name long-site-name) + software-type software-version + short-site-name long-site-name) () (or simple-string null) (flushable)) (defknown identity (t) t (movable foldable flushable unsafe) @@ -1301,6 +1375,8 @@ ;;;; miscellaneous extensions (defknown get-bytes-consed () unsigned-byte (flushable)) +(defknown mask-signed-field ((integer 0 *) integer) integer + (movable flushable foldable)) ;;; PCOUNTERs (defknown incf-pcounter (pcounter unsigned-byte) pcounter) @@ -1324,6 +1400,8 @@ (defknown %listify-rest-args (t index) list (flushable)) (defknown %more-arg-context (t t) (values t index) (flushable)) (defknown %more-arg (t index) t) +#!+stack-grows-downward-not-upward +(defknown %more-kw-arg (t index) (values t t)) (defknown %more-arg-values (t index index) * (flushable)) (defknown %verify-arg-count (index index) (values)) (defknown %arg-count-error (t) nil) @@ -1337,10 +1415,12 @@ (defknown %nlx-entry (t) *) (defknown %%primitive (t t &rest t) *) (defknown %pop-values (t) t) +(defknown %nip-values (t t &rest t) (values)) +(defknown %allocate-closures (t) *) (defknown %type-check-error (t t) nil) ;; FIXME: This function does not return, but due to the implementation -;; of FILTER-CONTINUATION we cannot write it here. +;; of FILTER-LVAR we cannot write it here. (defknown %compile-time-type-error (t t t) *) (defknown %odd-key-args-error () nil) @@ -1352,11 +1432,23 @@ (defknown %negate (number) number (movable foldable flushable explicit-check)) (defknown %check-bound (array index fixnum) index (movable foldable flushable)) (defknown data-vector-ref (simple-array index) t - (foldable explicit-check)) -(defknown data-vector-set (array index t) t (unsafe explicit-check)) + (foldable explicit-check always-translatable)) +#!+x86 +(defknown data-vector-ref-with-offset (simple-array index fixnum) t + (foldable explicit-check always-translatable)) +(defknown data-vector-set (array index t) t + (unsafe explicit-check always-translatable)) +#!+x86 +(defknown data-vector-set-with-offset (array index fixnum t) t + (unsafe explicit-check always-translatable)) (defknown hairy-data-vector-ref (array index) t (foldable explicit-check)) (defknown hairy-data-vector-set (array index t) t (unsafe explicit-check)) +(defknown hairy-data-vector-ref/check-bounds (array index) t + (foldable explicit-check)) +(defknown hairy-data-vector-set/check-bounds (array index t) + t + (unsafe explicit-check)) (defknown %caller-frame-and-pc () (values t t) (flushable)) (defknown %with-array-data (array index (or index null)) (values (simple-array * (*)) index index index) @@ -1390,32 +1482,62 @@ (defknown sb!impl::signal-bounding-indices-bad-error (sequence index sequence-end) nil) ; never returns - + (defknown arg-count-error (t t t t t t) nil (unsafe)) ;;;; SETF inverses -(defknown %aset (array &rest t) t (unsafe)) -(defknown %set-row-major-aref (array index t) t (unsafe)) -(defknown %rplaca (cons t) t (unsafe)) -(defknown %rplacd (cons t) t (unsafe)) +(defknown %aset (array &rest t) t (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +(defknown %set-row-major-aref (array index t) t (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +(defknown (%rplaca %rplacd) (cons t) t (unsafe) + :destroyed-constant-args (nth-constant-args 1)) (defknown %put (symbol t t) t (unsafe)) -(defknown %setelt (sequence index t) t (unsafe)) -(defknown %svset (simple-vector index t) t (unsafe)) -(defknown %bitset ((array bit) &rest index) bit (unsafe)) -(defknown %sbitset ((simple-array bit) &rest index) bit (unsafe)) -(defknown %charset (string index character) character (unsafe)) -(defknown %scharset (simple-string index character) character (unsafe)) +(defknown %setelt (sequence index t) t (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +(defknown %svset (simple-vector index t) t (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +(defknown %bitset ((array bit) &rest index) bit (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +(defknown %sbitset ((simple-array bit) &rest index) bit (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +(defknown %charset (string index character) character (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +(defknown %scharset (simple-string index character) character (unsafe) + :destroyed-constant-args (nth-constant-args 1)) (defknown %set-symbol-value (symbol t) t (unsafe)) (defknown (setf symbol-function) (function symbol) function (unsafe)) (defknown %set-symbol-plist (symbol t) t (unsafe)) (defknown (setf fdocumentation) ((or string null) t symbol) (or string null) ()) -(defknown %setnth (index list t) t (unsafe)) -(defknown %set-fill-pointer (vector index) index (unsafe)) +(defknown %setnth (unsigned-byte list t) t (unsafe) + :destroyed-constant-args (nth-constant-args 2)) +(defknown %set-fill-pointer (vector index) index (unsafe) + :destroyed-constant-args (nth-constant-args 1)) +;;;; ALIEN and call-out-to-C stuff + +;;; 'unsafe' attribute because we store the arg on the stack, which is in +;;; some sense 'passing it upwards' +(defknown sb!vm::push-word-on-c-stack (system-area-pointer) (values) (unsafe)) +(defknown sb!vm::pop-words-from-c-stack (index) (values) ()) + +#!+linkage-table +(defknown foreign-symbol-dataref-sap (simple-string) + system-area-pointer + (movable flushable)) + +(defknown foreign-symbol-sap (simple-string &optional boolean) + system-area-pointer + (movable flushable)) + +(defknown foreign-symbol-address (simple-string &optional boolean) + (values integer boolean) + (movable flushable)) + ;;;; miscellaneous internal utilities (defknown %fun-name (function) t (flushable)) @@ -1423,3 +1545,10 @@ (defknown policy-quality (policy symbol) policy-quality (flushable)) + +(defknown compiler-error (t &rest t) nil ()) +(defknown (compiler-warn compiler-style-warn) (string &rest t) (values) ()) +(defknown (compiler-notify maybe-compiler-notify) ((or string symbol) &rest t) + (values) + ()) +(defknown style-warn (string &rest t) null ())