Skip to content
fndb.lisp 48.5 KiB
Newer Older
wlott's avatar
wlott committed
;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
ram's avatar
ram committed
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: src/compiler/fndb.lisp $")
ram's avatar
ram committed
;;;
wlott's avatar
wlott committed
;;; **********************************************************************
;;;
;;;    This file defines all the standard functions to be known functions.
;;; Each function has type and side-effect information, and may also have IR1
;;; optimizers.
;;;
;;; Written by Rob MacLachlan
;;;
(in-package "C")
(intl:textdomain "cmucl")
wlott's avatar
wlott committed

(in-package "LISP")
wlott's avatar
wlott committed
(import '(
	  %aset
	  %bitset
	  %charset
	  %primitive
	  %put
ram's avatar
ram committed
	  %puthash
wlott's avatar
wlott committed
	  %rplaca
	  %rplacd
	  %sbitset
	  %scharset
	  %set-fdefinition
	  %set-fill-pointer
	  %set-row-major-aref
wlott's avatar
wlott committed
	  %setelt
	  %setnth
	  %standard-char-p
	  %svset
	  %typep
	  array-header-p
	  base-char-p
wlott's avatar
wlott committed
	  double-float-p
	  long-float-p
	  short-float-p
	  single-float-p
	  string<*
	  string>*
	  string<=*
	  string>=*
	  string=*
	  string/=*
	  %sp-string-compare
	  )
	"C")

ram's avatar
ram committed
(in-package "KERNEL")

(export '(%caller-frame-and-pc %with-array-data))
ram's avatar
ram committed

ram's avatar
ram committed
(in-package "C")
wlott's avatar
wlott committed

toy's avatar
toy committed
(deftype lexenv-or-null () '(or null lexical-environment))

wlott's avatar
wlott committed

;;;; Information for known functions:

(defknown coerce (t type-specifier) t
	  (movable foldable)			  ; Is defined to signal errors. 
toy's avatar
toy committed
	  ;; :derive-type (result-type-specifier-nth-arg 2)
	  ;; This is wrong.  (coerce 1 'complex) returns 1, not COMPLEX.
  )
wlott's avatar
wlott committed

(defknown type-of (t) t (foldable flushable))

;;; Can be affected by type definitions...
(defknown (upgraded-complex-part-type upgraded-array-element-type)
toy's avatar
toy committed
	  (type-specifier &optional lexenv-or-null)
          type-specifier
	  (flushable))
wlott's avatar
wlott committed

;;;; In the "Predicates" chapter:

toy's avatar
toy committed
(defknown typep (t type-specifier &optional lexenv-or-null)
          boolean (foldable flushable))
(defknown subtypep (type-specifier type-specifier &optional lexenv-or-null)
          (values boolean boolean)
wlott's avatar
wlott committed
	  (foldable 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
		packagep functionp compiled-function-p not)
wlott's avatar
wlott committed
  (t) boolean (movable foldable flushable))


(defknown (eq eql) (t t) boolean (movable foldable flushable))
(defknown (equal equalp) (t t) boolean (foldable flushable recursive))
wlott's avatar
wlott committed

(defknown kernel::find-class (t &optional t lexenv-or-null)
  (or kernel::class null) ())
(defknown kernel::class-of (t) kernel::class (flushable))
(defknown layout-of (t) layout (flushable))
(defknown copy-structure (structure-object) structure-object
  (flushable unsafe))

wlott's avatar
wlott committed

;;;; In the "Control Structure" chapter:

;;; Not flushable, since required to signal an error if unbound.
(defknown symbol-value (symbol) t ())
(defknown symbol-function (symbol) function ())
wlott's avatar
wlott committed

(defknown boundp (symbol) boolean (flushable))
(defknown fboundp ((or symbol cons)) boolean (flushable explicit-check))
(defknown special-operator-p (symbol) t (movable foldable flushable)) ; They never change...
wlott's avatar
wlott committed
(defknown set (symbol t) t (unsafe)
  :derive-type #'result-type-last-arg)
(defknown fdefinition ((or symbol cons)) function (unsafe explicit-check))
(defknown %set-fdefinition ((or symbol cons) function) function
  (unsafe explicit-check))
wlott's avatar
wlott committed
(defknown makunbound (symbol) symbol)
(defknown fmakunbound ((or symbol cons)) (or symbol cons)
  (unsafe explicit-check))
toy's avatar
toy committed
(defknown get-setf-expansion ((or list symbol) &optional lexenv-or-null)
pw's avatar
pw committed
 (values list list list form form)
 (flushable))
(defknown apply (callable t &rest t) *) ; ### Last arg must be List...
wlott's avatar
wlott committed
(defknown funcall (callable &rest t) *)

(defknown (mapcar maplist mapcan mapcon) (callable list &rest list) list
  (call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

(defknown (mapc mapl) (callable list &rest list) list
  (foldable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

;;; We let values-list be foldable, since constant-folding will turn it into
;;; VALUES.  VALUES is not foldable, since MV constants are represented by a
;;; call to VALUES.
;;; 
(defknown values (&rest t) * (movable flushable unsafe))
(defknown values-list (list) * (movable foldable flushable))
wlott's avatar
wlott committed


;;;; In the "Macros" chapter:

toy's avatar
toy committed
(defknown macro-function (symbol &optional lexenv-or-null)
  (or function null)
  (flushable))
toy's avatar
toy committed
(defknown (macroexpand macroexpand-1) (t &optional lexenv-or-null)
  (values form &optional boolean))

toy's avatar
toy committed
(defknown compiler-macro-function (t &optional lexenv-or-null)
  (or function null)
  (flushable))
wlott's avatar
wlott committed


;;;; In the "Declarations" chapter:

(defknown proclaim (list) void)


;;;; In the "Symbols" chapter:

(defknown get (symbol t &optional 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 copy-symbol (symbol &optional t) symbol (flushable))
(defknown gensym (&optional (or string unsigned-byte)) symbol ())
(defknown symbol-package (symbol) (or package null) (flushable))
wlott's avatar
wlott committed
(defknown keywordp (t) boolean (flushable))	  ; If someone uninterns it...


;;;; In the "Packages" chapter:

(deftype packagelike () '(or stringable package))
wlott's avatar
wlott committed
(deftype symbols () '(or list symbol))

;;; Should allow a package name, I think, tho CLtL II doesn't say so...
(defknown gentemp (&optional string packagelike) symbol)

(defknown make-package (stringable &key (:use list) (:nicknames list)
wlott's avatar
wlott committed
				   ;; ### Extensions...
ram's avatar
ram committed
				   (:internal-symbols index) (:external-symbols index))
wlott's avatar
wlott committed
	  package)
(defknown find-package (packagelike) (or package null) (flushable))
(defknown package-name (packagelike) (or simple-string null) (flushable))
(defknown package-nicknames (packagelike) list (flushable))
(defknown rename-package (packagelike packagelike &optional list) package)
(defknown package-use-list (packagelike) list (flushable))
(defknown package-used-by-list (packagelike) list (flushable))
(defknown package-shadowing-symbols (packagelike) list (flushable))
wlott's avatar
wlott committed
(defknown list-all-packages () list (flushable))
(defknown intern (string &optional packagelike)
  (values symbol (member :internal :external :inherited nil))
wlott's avatar
wlott committed
  ())
(defknown find-symbol (string &optional packagelike)
	  (values symbol (member :internal :external :inherited nil))
wlott's avatar
wlott committed
	  (flushable))
(defknown (export import) (symbols &optional packagelike) truth)
(defknown unintern (symbol &optional packagelike) boolean)
(defknown unexport (symbols &optional packagelike) truth)
(defknown shadowing-import (symbols &optional packagelike) truth)
(defknown shadow ((or symbol character string list) &optional packagelike) truth)
wlott's avatar
wlott committed
(defknown (use-package unuse-package) ((or list packagelike) &optional packagelike) truth)
(defknown find-all-symbols (stringable) list (flushable))
wlott's avatar
wlott committed


;;;; In the "Numbers" chapter:

(defknown zerop (number) boolean (movable foldable flushable explicit-check))
(defknown (plusp minusp) (real) boolean
  (movable foldable flushable explicit-check))
(defknown (oddp evenp) (integer) boolean
  (movable foldable flushable explicit-check))
(defknown (= /=) (number &rest number) boolean
  (movable foldable flushable explicit-check))
(defknown (< > <= >=) (real &rest real) boolean
  (movable foldable flushable explicit-check))
(defknown (max min) (real &rest real) real
  (movable foldable flushable explicit-check))

(defknown + (&rest number) number
  (movable foldable flushable explicit-check))
(defknown - (number &rest number) number
  (movable foldable flushable explicit-check))
(defknown * (&rest number) number
  (movable foldable flushable explicit-check))
(defknown / (number &rest number) number
  (movable foldable flushable explicit-check))
(defknown (1+ 1-) (number) number
  (movable foldable flushable explicit-check))

(defknown conjugate (number) number
  (movable foldable flushable explicit-check))

(defknown gcd (&rest integer) unsigned-byte
  (movable foldable flushable explicit-check)
  #|:derive-type 'boolean-result-type|#)
(defknown lcm (&rest integer) unsigned-byte
  (movable foldable flushable explicit-check))
dtc's avatar
dtc committed
(defknown exp (number) irrational
  (movable foldable flushable explicit-check recursive))


(defknown expt (number number) number
  (movable foldable flushable explicit-check recursive))
(defknown log (number &optional real) irrational
  (movable foldable flushable explicit-check))
(defknown sqrt (number) irrational
  (movable foldable flushable explicit-check))
(defknown isqrt (unsigned-byte) unsigned-byte
  (movable foldable flushable explicit-check))

(defknown (abs phase signum) (number) number
  (movable foldable flushable explicit-check))
(defknown cis (real) (complex float)
  (movable foldable flushable explicit-check))

dtc's avatar
dtc committed
(defknown (sin cos) (number)
  (or (float -1.0 1.0) (complex float))
dtc's avatar
dtc committed
  (movable foldable flushable explicit-check recursive))

(defknown atan
  (number &optional real) irrational
  (movable foldable flushable explicit-check recursive))

(defknown (tan sinh cosh tanh asinh)
  (number) irrational (movable foldable flushable explicit-check recursive))

(defknown (asin acos acosh atanh)
  (number) irrational
  (movable foldable flushable explicit-check recursive))

(defknown float (real &optional float) float
  (movable foldable flushable explicit-check))

(defknown (rational rationalize) (real) rational
  (movable foldable flushable explicit-check))

(defknown (numerator denominator) (rational) integer
  (movable foldable flushable))
wlott's avatar
wlott committed
(defknown (floor ceiling truncate round)
  (real &optional real) (values integer real)
  (movable foldable flushable explicit-check))

(defknown (mod rem) (real real) real
  (movable foldable flushable explicit-check))

wlott's avatar
wlott committed
(defknown (ffloor fceiling fround ftruncate)
  (real &optional real) (values float real)
  (movable foldable flushable explicit-check))
wlott's avatar
wlott committed

(defknown decode-float (float)
  (values (float 0.5d0 (1d0))
	  float-exponent
	  (member 1f0 -1f0 -1d0 1d0
		  #+double-double -1w0
		  #+double-double 1w0))
  (movable foldable flushable explicit-check))
(defknown scale-float (float float-exponent) float
  (movable foldable flushable explicit-check))
(defknown float-radix (float) float-radix
  (movable foldable flushable explicit-check))
(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))
wlott's avatar
wlott committed
(defknown integer-decode-float (float)
	  (values integer float-exponent (member -1 1))
	  (movable foldable flushable explicit-check))

(defknown complex (real &optional real) number
  (movable foldable flushable explicit-check))

wlott's avatar
wlott committed
(defknown (realpart imagpart) (number) real (movable foldable flushable))

(defknown (logior logxor logand logeqv) (&rest integer) integer
  (movable foldable flushable explicit-check))

(defknown (lognand lognor logandc1 logandc2 logorc1 logorc2)
	  (integer integer) integer
  (movable foldable flushable explicit-check))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown boole (boole-code integer integer) integer
(defknown lognot (integer) integer (movable foldable flushable explicit-check))
(defknown logtest (integer integer) boolean (movable foldable flushable))
(defknown logbitp (unsigned-byte integer) boolean (movable foldable flushable))
(defknown ash (integer ash-index) integer (movable foldable flushable explicit-check))
wlott's avatar
wlott committed
(defknown (logcount integer-length) (integer) bit-index
  (movable foldable flushable explicit-check))
wlott's avatar
wlott committed
(defknown byte (bit-index bit-index) byte-specifier
  (movable foldable flushable))
(defknown (byte-size byte-position) (byte-specifier) bit-index
  (movable foldable flushable)) 
(defknown ldb (byte-specifier integer) integer (movable foldable flushable))
(defknown ldb-test (byte-specifier integer) boolean
  (movable foldable flushable))
(defknown mask-field (byte-specifier integer) integer
  (movable foldable flushable))
(defknown dpb (integer byte-specifier integer) integer
  (movable foldable flushable))
(defknown deposit-field (integer byte-specifier integer) integer
  (movable foldable flushable))
(defknown random (real &optional random-state) real ())
(defknown make-random-state (&optional (or (member nil t) random-state))
  random-state (flushable))
(defknown random-state-p (t) boolean (movable foldable flushable))

;;; In "Characters" chapter:
(defknown (standard-char-p graphic-char-p alpha-char-p
wlott's avatar
wlott committed
			   upper-case-p lower-case-p both-case-p alphanumericp)
  (character) boolean (movable foldable flushable))

(defknown digit-char-p (character &optional unsigned-byte)
  (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)
  (character &rest character) boolean (movable foldable flushable))

(defknown character (t) character (movable foldable flushable))
(defknown char-code (character) char-code (movable foldable flushable))
(defknown code-char (char-code) base-char (movable foldable flushable))
(defknown (char-upcase char-downcase) (character) character
  (movable foldable flushable))
(defknown digit-char (integer &optional integer)
wlott's avatar
wlott committed
  (or character null) (movable foldable flushable))
(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)
  (movable foldable flushable))
wlott's avatar
wlott committed


;;;; In the "Sequences" chapter:

(defknown elt (sequence index) t (foldable flushable))

(defknown subseq (sequence index &optional sequence-end) consed-sequence
  :derive-type (sequence-result-nth-arg 1))
wlott's avatar
wlott committed

(defknown copy-seq (sequence) consed-sequence (flushable)
  :derive-type (sequence-result-nth-arg 1))
wlott's avatar
wlott committed

(defknown length (sequence) index (foldable flushable))

(defknown reverse (sequence) consed-sequence (flushable)
  :derive-type #'result-type-first-arg/reverse)
wlott's avatar
wlott committed

(defknown nreverse (sequence) sequence ()
  :derive-type #'result-type-first-arg/reverse
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)
  :result-not-used (list-function-result-not-used 1))
wlott's avatar
wlott committed

(defknown make-sequence (type-specifier index &key (:initial-element t)) consed-sequence
  ;; Nope:  If the type-specifier isn't a consed-sequence, we get confused.
  ;;:derive-type (result-type-specifier-nth-arg 1)
  )
wlott's avatar
wlott committed

(defknown concatenate (type-specifier &rest sequence) consed-sequence
  ;; Nope:  If the type-specifier isn't a consed-sequence, we get confused.
  ;;:derive-type (result-type-specifier-nth-arg 1)
  )
wlott's avatar
wlott committed

(defknown map (type-specifier callable sequence &rest sequence) consed-sequence
  (flushable call dynamic-extent-closure-safe)
wlott's avatar
wlott committed
;  :derive-type 'type-spec-arg1  Nope... (map nil ...) returns null, not nil.
  )

(defknown map-into (sequence callable &rest sequence)
  sequence
  (call dynamic-extent-closure-safe)
  :derive-type #'result-type-first-arg
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
wlott's avatar
wlott committed
;;; Returns predicate result... 
(defknown some (callable sequence &rest sequence) t
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

(defknown (every notany notevery) (callable sequence &rest sequence) boolean
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

;;; Unsafe for :Initial-Value...
ram's avatar
ram committed
(defknown reduce (callable sequence &key (:from-end t) (:start index)
			   (:end sequence-end) (:initial-value t) (:key callable))
wlott's avatar
wlott committed
  t
  (foldable flushable call unsafe dynamic-extent-closure-safe))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown fill (sequence t &key (:start index) (:end sequence-end)) sequence
wlott's avatar
wlott committed
  (unsafe)
  :derive-type #'result-type-first-arg
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown replace (sequence sequence &key (:start1 index) (:end1 sequence-end)
			    (:start2 index) (:end2 sequence-end))
  :derive-type #'result-type-first-arg
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
wlott's avatar
wlott committed

(defknown remove
ram's avatar
ram committed
  (t sequence &key (:from-end t) (:test callable)
     (:test-not callable) (:start index) (:end sequence-end)
     (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  consed-sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 2))
wlott's avatar
wlott committed

(defknown substitute
ram's avatar
ram committed
  (t t sequence &key (:from-end t) (:test callable)
     (:test-not callable) (:start index) (:end sequence-end)
     (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  consed-sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 3))
wlott's avatar
wlott committed

(defknown (remove-if remove-if-not)
ram's avatar
ram committed
  (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
	    (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  consed-sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 2))
wlott's avatar
wlott committed

(defknown (substitute-if substitute-if-not)
ram's avatar
ram committed
  (t callable sequence &key (:from-end t) (:start index) (:end sequence-end)
     (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  consed-sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 3))
wlott's avatar
wlott committed

(defknown delete
ram's avatar
ram committed
  (t sequence &key (:from-end t) (:test callable)
     (:test-not callable) (:start index) (:end sequence-end)
     (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 2)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)
  :result-not-used (list-function-result-not-used 2))
wlott's avatar
wlott committed

(defknown nsubstitute
ram's avatar
ram committed
  (t t sequence &key (:from-end t) (:test callable)
     (:test-not callable) (:start index) (:end sequence-end)
     (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 3)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
wlott's avatar
wlott committed

(defknown (delete-if delete-if-not)
ram's avatar
ram committed
  (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
	    (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 2)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2)
  :result-not-used (list-function-result-not-used 2))
wlott's avatar
wlott committed

(defknown (nsubstitute-if nsubstitute-if-not)
ram's avatar
ram committed
  (t callable sequence &key (:from-end t) (:start index) (:end sequence-end)
     (:count sequence-count) (:key callable))
wlott's avatar
wlott committed
  sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 3)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
wlott's avatar
wlott committed

(defknown remove-duplicates
ram's avatar
ram committed
  (sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t)
	    (:end sequence-end) (:key callable))
wlott's avatar
wlott committed
  consed-sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 1))
wlott's avatar
wlott committed

(defknown delete-duplicates
ram's avatar
ram committed
  (sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t)
	    (:end sequence-end) (:key callable))
wlott's avatar
wlott committed
  sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 1)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)
  :result-not-used (list-function-result-not-used 1))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown find (t sequence &key (:test callable) (:test-not callable)
		  (:start index) (:from-end t) (:end sequence-end) (:key callable))
wlott's avatar
wlott committed
  t
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

(defknown (find-if find-if-not)
ram's avatar
ram committed
  (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
	    (:key callable))
wlott's avatar
wlott committed
  t
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown position (t sequence &key (:test callable) (:test-not callable)
		      (:start index) (:from-end t) (:end sequence-end)
		      (:key callable))
wlott's avatar
wlott committed
  (or index null)
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

(defknown (position-if position-if-not)
ram's avatar
ram committed
  (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
	    (:key callable))
wlott's avatar
wlott committed
  (or index null)
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown count (t sequence &key (:test callable) (:test-not callable)
		      (:start index) (:from-end t) (:end sequence-end)
		      (:key callable))
wlott's avatar
wlott committed
  index
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

(defknown (count-if count-if-not)
ram's avatar
ram committed
  (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
	    (:key callable))
wlott's avatar
wlott committed
  index
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

(defknown (mismatch search)
ram's avatar
ram committed
  (sequence sequence &key (:from-end t) (:test callable) (:test-not callable)
	    (:start1 index) (:end1 sequence-end) (:start2 index) (:end2 sequence-end)
	    (:key callable))
wlott's avatar
wlott committed
  (or index null)
  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

;;; Not flushable, since vector sort guaranteed in-place...
ram's avatar
ram committed
(defknown (stable-sort sort) (sequence callable &key (:key callable)) sequence
  (call dynamic-extent-closure-safe)
  :derive-type (sequence-result-nth-arg 1)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)
  :result-not-used (list-function-result-not-used 1))
wlott's avatar
wlott committed

(defknown merge (type-specifier sequence sequence callable
ram's avatar
ram committed
				&key (:key callable))
wlott's avatar
wlott committed
  sequence
  (flushable call dynamic-extent-closure-safe)
  :derive-type (result-type-specifier-nth-arg 1)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2 3)
  ;; FIXME!  This is a little complicated.  
  ;;:result-not-used #'function-result-not-used-p
  )
wlott's avatar
wlott committed

(defknown read-sequence (sequence stream &key (:start index)
					      (:end sequence-end)
					      (:partial-fill boolean))

(defknown write-sequence (sequence stream &key (:start index)
				   (:end sequence-end))
  :derive-type (sequence-result-nth-arg 1))

wlott's avatar
wlott committed

;;;; In the "Manipulating List Structure" chapter:

(defknown (car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr
	       cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar
	       cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
	       first second third fourth fifth sixth seventh eighth ninth tenth
	       rest)
  (list) t (foldable flushable))

(defknown cons (t t) cons (movable flushable unsafe))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown tree-equal (t t &key (:test callable) (:test-not callable)) boolean
  (foldable flushable call dynamic-extent-closure-safe))
(defknown endp (list) boolean (foldable flushable movable))
wlott's avatar
wlott committed
(defknown list-length (list) (or index null) (foldable flushable))
(defknown (nth nthcdr) (unsigned-byte list) t (foldable flushable))
(defknown last (list &optional unsigned-byte) list (foldable flushable))
(defknown list (&rest t) list (movable flushable unsafe))
(defknown list* (t &rest t) t (movable flushable unsafe))
ram's avatar
ram committed
(defknown make-list (index &key (:initial-element t)) list
  (movable flushable unsafe))
wlott's avatar
wlott committed

;;;
;;; All but last must be list...
(defknown append (&rest t) t (flushable))

(defknown copy-list (list) list (flushable))
(defknown copy-alist (list) list (flushable))
(defknown copy-tree (t) t (flushable))
(defknown revappend (list t) t (flushable))
(defknown nconc (&rest t) t ()
  :destroyed-constant-args (remove-non-constants-and-nils #'butlast))
(defknown nreconc (list t) list ()
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)
  :result-not-used #'function-result-not-used-p)
(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 ldiff (list t) list (flushable))
(defknown (rplaca rplacd) (cons t) list (unsafe)
  :destroyed-constant-args (nth-constant-args 1))

(defknown subst (t t t &key (:key callable) (:test callable)
                   (:test-not callable))
  t (flushable unsafe call))
wlott's avatar
wlott committed

(defknown (nsubst) (t t t &key (:key callable) (:test callable)
ram's avatar
ram committed
			    (:test-not callable))
  list (flushable unsafe call dynamic-extent-closure-safe)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))

(defknown (subst-if subst-if-not nsubst-if nsubst-if-not)
ram's avatar
ram committed
	  (t t t &key (:key callable))
  list (flushable unsafe call dynamic-extent-closure-safe)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 3))
(defknown (sublis) (list t &key (:key callable) (:test callable)
ram's avatar
ram committed
				 (:test-not callable))
  list (flushable unsafe call dynamic-extent-closure-safe))
(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))

ram's avatar
ram committed
(defknown member (t list &key (:key callable) (:test callable)
		    (:test-not callable))
  list (foldable flushable call dynamic-extent-closure-safe))
ram's avatar
ram committed
(defknown (member-if member-if-not) (callable list &key (:key callable))
  list (foldable flushable call dynamic-extent-closure-safe))
(defknown tailp (t list) boolean (foldable flushable))
ram's avatar
ram committed
(defknown adjoin (t list &key (:key callable) (:test callable)
		    (:test-not callable))
  list (foldable flushable unsafe call dynamic-extent-closure-safe))

(defknown (union intersection set-difference set-exclusive-or)
ram's avatar
ram committed
	  (list list &key (:key callable) (:test callable) (:test-not callable))
  (foldable flushable call dynamic-extent-closure-safe))

(defknown (nunion nintersection nset-difference nset-exclusive-or)
ram's avatar
ram committed
	  (list list &key (:key callable) (:test callable) (:test-not callable))
  (foldable flushable call dynamic-extent-closure-safe)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1 2)
  :result-not-used #'function-result-not-used-p)
(defknown subsetp (list list &key (:key callable) (:test callable)
			(:test-not callable))
  (foldable flushable call dynamic-extent-closure-safe))

(defknown acons (t t t) list (movable flushable unsafe))
wlott's avatar
wlott committed
(defknown pairlis (t t &optional t) list (flushable unsafe))
ram's avatar
ram committed
	  (t list &key (:key callable) (:test callable) (:test-not callable))
  list (foldable flushable call dynamic-extent-closure-safe))
(defknown (assoc-if-not assoc-if rassoc-if rassoc-if-not)
	  (callable list &key (:key callable)) list
	  (foldable flushable call dynamic-extent-closure-safe))
wlott's avatar
wlott committed

ram's avatar
ram committed
(defknown (memq assq) (t list) list (foldable flushable unsafe))
(defknown delq (t list) list (flushable unsafe)
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 2))
ram's avatar
ram committed
  
wlott's avatar
wlott committed

;;;; In the "Hash Tables" chapter:

(defknown make-hash-table
ram's avatar
ram committed
  (&key (:test callable) (:size index)
	(:rehash-size (or (integer 1) (float (1.0))))
	(:rehash-threshold (real 0 1))
	(:weak-p t))
wlott's avatar
wlott committed
  hash-table
  (flushable unsafe))
(defknown hash-table-p (t) boolean (movable foldable flushable))
(defknown gethash (t hash-table &optional t) (values t boolean)
  (foldable flushable unsafe))
(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
  (foldable flushable call dynamic-extent-closure-safe))
(defknown clrhash (hash-table) hash-table ()
  :destroyed-constant-args (nth-constant-args 1))
(defknown hash-table-count (hash-table) index (foldable flushable))
(defknown hash-table-rehash-size (hash-table) (or (integer 1) (float (1.0)))
  (foldable flushable))
(defknown hash-table-rehash-threshold (hash-table) (real 0 1)
  (foldable flushable))
(defknown hash-table-size (hash-table) index (foldable flushable))
(defknown hash-table-test (hash-table) symbol (foldable flushable))
wlott's avatar
wlott committed
(deftype non-negative-fixnum () `(integer 0 ,most-positive-fixnum))
(defknown sxhash (t) non-negative-fixnum (foldable flushable))


;;;; In the "Arrays" chapter:

ram's avatar
ram committed
(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)
rtoy's avatar
rtoy committed
		      (:allocation (member nil :malloc)))
wlott's avatar
wlott committed
  array (flushable unsafe))

(defknown vector (&rest t) simple-vector (flushable unsafe))

(defknown aref (array &rest index) t (foldable flushable))
(defknown row-major-aref (array index) t (foldable flushable))
wlott's avatar
wlott committed

(defknown array-element-type (array) type-specifier (foldable flushable))
(defknown array-rank (array) array-rank (foldable flushable))
(defknown array-dimension (array array-rank) index (foldable flushable))
(defknown array-dimensions (array) list (foldable flushable))
(defknown array-in-bounds-p (array &rest integer) boolean (foldable flushable))
wlott's avatar
wlott committed
(defknown array-row-major-index (array &rest index) array-total-size
  (foldable flushable)) 
(defknown array-total-size (array) array-total-size (foldable flushable))
(defknown adjustable-array-p (array) boolean (movable foldable flushable))

(defknown svref (simple-vector index) t (foldable flushable))
(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.
wlott's avatar
wlott committed
(defknown (bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1 bit-andc2
		   bit-orc1 bit-orc2)
  ((array bit) (array bit) &optional (or (array bit) (member nil t)))
wlott's avatar
wlott committed
  (array bit)
  (foldable)
ram's avatar
ram committed
  #|:derive-type #'result-type-last-arg|#)
wlott's avatar
wlott committed

(defknown bit-not ((array bit) &optional (or (array bit) (member nil t)))
wlott's avatar
wlott committed
  (array bit)
  (foldable)
  #|:derive-type #'result-type-last-arg|#)
wlott's avatar
wlott committed

(defknown array-has-fill-pointer-p (array) boolean (movable foldable flushable))
(defknown fill-pointer (vector) index (foldable flushable))
(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.
wlott's avatar
wlott committed
(defknown adjust-array
ram's avatar
ram committed
  (array (or index list) &key (:element-type type-specifier)
	 (:initial-element t) (:initial-contents t)
ram's avatar
ram committed
	 (:fill-pointer t) (:displaced-to (or array null))
	 (:displaced-index-offset index))
  array (unsafe)
  :result-not-used #'adjust-array-result-not-used-p)
wlott's avatar
wlott committed
;  :derive-type 'result-type-arg1) Not even close...


;;;; In the "Strings" chapter:

(defknown char (string index) character (foldable flushable))
(defknown schar (simple-string index) character (foldable flushable))
wlott's avatar
wlott committed

(deftype stringable () '(or character string symbol))

;; Case folding mode (in case we want language-specific converssions)
#+unicode
(deftype case-folding-type ()
  `(member :simple :full))

;; Case conversion mode (in case we ever want language-specific conversions)
#+unicode
(deftype case-conversion-type ()
  `(member :simple :full))

wlott's avatar
wlott committed
(defknown (string= string-equal)
ram's avatar
ram committed
  (stringable stringable &key (:start1 index) (:end1 sequence-end)
	      (:start2 index) (:end2 sequence-end))
wlott's avatar
wlott committed
  boolean
  (foldable flushable))

(defknown (string< string> string<= string>= string/= string-lessp
		   string-greaterp string-not-lessp string-not-greaterp
		   string-not-equal)
ram's avatar
ram committed
  (stringable stringable &key (:start1 index) (:end1 sequence-end)
	      (:start2 index) (:end2 sequence-end))
wlott's avatar
wlott committed
  (or index null)
  (foldable flushable))

dtc's avatar
dtc committed
(defknown make-string (index &key (:element-type type-specifier)
		       (:initial-element character))
wlott's avatar
wlott committed
  simple-string (flushable))

(defknown (string-trim string-left-trim string-right-trim)
  (sequence stringable) simple-string (flushable))
wlott's avatar
wlott committed

(defknown (string-upcase string-downcase)
  (stringable &key (:start index) (:end sequence-end))
wlott's avatar
wlott committed
  simple-string (flushable))

(defknown (string-capitalize)
  (stringable &key (:start index) (:end sequence-end))
  simple-string (flushable))

wlott's avatar
wlott committed
(defknown (nstring-upcase nstring-downcase nstring-capitalize)
ram's avatar
ram committed
  (string &key (:start index) (:end sequence-end))
  string ()
  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
wlott's avatar
wlott committed

(defknown string (stringable) string
  (flushable explicit-check))
wlott's avatar
wlott committed


;;; Internal non-keyword versions of string predicates:

(defknown (string<* string>* string<=* string>=* string/=*)
  (stringable stringable index sequence-end index sequence-end)
wlott's avatar
wlott committed
  (or index null)
  (foldable flushable))

(defknown string=*
  (stringable stringable index sequence-end index sequence-end)
wlott's avatar
wlott committed
  boolean
  (foldable flushable))


;;;; In the "Eval" chapter:

(defknown eval (t) *)
toy's avatar
toy committed
(defknown constantp (t &optional lexenv-or-null) boolean
dtc's avatar
dtc committed
  (foldable flushable))
wlott's avatar
wlott committed


;;;; In the "Streams" chapter:

(defknown make-synonym-stream (symbol) stream (flushable))
(defknown make-broadcast-stream (&rest stream) stream (flushable))
(defknown make-concatenated-stream (&rest stream) stream (flushable))
(defknown make-two-way-stream (stream stream) stream (flushable))
(defknown make-echo-stream (stream stream) stream (flushable))
wlott's avatar
wlott committed
(defknown make-string-input-stream (string &optional index index) stream (flushable unsafe))
(defknown make-string-output-stream (&key (:element-type type-specifier))
  stream
  (flushable))
wlott's avatar
wlott committed
(defknown get-output-stream-string (stream) simple-string ())
(defknown streamp (t) boolean (movable foldable flushable))
(defknown stream-element-type (stream) type-specifier (movable foldable flushable))
(defknown (output-stream-p input-stream-p) (stream) boolean (movable foldable
								     flushable))
(defknown close (stream &key (:abort t)) t ())
wlott's avatar
wlott committed


;;;; In the "Input/Output" chapter:

;;; The I/O functions are currently given effects ANY under the theory that
;;; code motion over I/O operations is particularly confusing and not very
;;; important for efficency.

dtc's avatar
dtc committed
(defknown copy-readtable (&optional (or readtable null) (or readtable null))
  readtable
wlott's avatar
wlott committed
(defknown readtablep (t) boolean (movable foldable flushable))

(defknown set-syntax-from-char
  (character character &optional (or readtable null) readtable) void
wlott's avatar
wlott committed

(defknown set-macro-character (character callable &optional t readtable) void
  (unsafe))
dtc's avatar
dtc committed
(defknown get-macro-character (character &optional (or readtable null))
wlott's avatar
wlott committed
  (values callable boolean) (flushable))

(defknown make-dispatch-macro-character (character &optional t readtable)
  void ())
wlott's avatar
wlott committed
(defknown set-dispatch-macro-character
  (character character callable &optional readtable) void
  (unsafe))
(defknown get-dispatch-macro-character
dtc's avatar
dtc committed
  (character character &optional (or readtable null)) callable
wlott's avatar
wlott committed

;;; 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))

(defknown read-delimited-list (character &optional streamlike t) list
  (explicit-check))
(defknown read-line (&optional streamlike t t t) (values t boolean)
  (explicit-check))
(defknown unread-char (character &optional streamlike) t
  (explicit-check))
(defknown peek-char (&optional (or character (member nil t)) streamlike t t t)
  t
  (explicit-check))
(defknown listen (&optional streamlike
			    (or null (integer 1 10) (member character)))
  boolean (flushable explicit-check))
wlott's avatar
wlott committed

(defknown clear-input (&optional stream boolean) null (explicit-check))
wlott's avatar
wlott committed

(defknown read-from-string
ram's avatar
ram committed
  (string &optional t t &key (:start index) (:end sequence-end)
	  (:preserve-whitespace t))
wlott's avatar
wlott committed
(defknown parse-integer
ram's avatar
ram committed
  (string &key (:start index) (:end sequence-end) (:radix (integer 2 36))
	  (:junk-allowed t)) 
  (values (or integer null ()) index))
wlott's avatar
wlott committed

(defknown read-byte (stream &optional t t) t (explicit-check))
wlott's avatar
wlott committed

(defknown write
ram's avatar
ram committed
  (t &key (:stream streamlike) (:escape t) (:radix t) (:base (integer 2 36))
     (:circle t) (:pretty t) (:level (or unsigned-byte null)) (:readably t)
     (:length (or unsigned-byte null)) (:case t) (:array t) (:gensym t)
     (:lines (or unsigned-byte null)) (:right-margin (or unsigned-byte null))
     (:miser-width (or unsigned-byte null)) (:pprint-dispatch t))
  :derive-type #'result-type-first-arg)
wlott's avatar
wlott committed

(defknown (prin1 print princ) (t &optional streamlike) t (any explicit-check)
  :derive-type #'result-type-first-arg)
wlott's avatar
wlott committed

;;; xxx-TO-STRING not foldable because they depend on the dynamic environment. 
(defknown write-to-string
ram's avatar
ram committed
  (t &key (:escape t) (:radix t) (:base (integer 2 36)) (:readably t)
     (:circle t) (:pretty t) (:level (or unsigned-byte null))
     (:length (or unsigned-byte null)) (:case t) (:array t) (:gensym t)
     (:lines (or unsigned-byte null)) (:right-margin (or unsigned-byte null))
     (:miser-width (or unsigned-byte null)) (:pprint-dispatch t))
wlott's avatar
wlott committed
  simple-string
  (foldable flushable explicit-check))
wlott's avatar
wlott committed

(defknown (prin1-to-string princ-to-string) (t) simple-string (flushable))

(defknown write-char (character &optional streamlike) character
  (explicit-check))
wlott's avatar
wlott committed
(defknown (write-string write-line)
ram's avatar
ram committed
  (string &optional streamlike &key (:start index) (:end sequence-end))
wlott's avatar
wlott committed

(defknown (terpri finish-output force-output clear-output)