;; If true, the function can stack-allocate the result. The
;; COMBINATION node is passed as an argument.
(stack-allocate-result nil :type (or function null))
+ ;; If true, the function can add flow-sensitive type information
+ ;; about the state of the world after its execution. The COMBINATION
+ ;; node is passed as an argument, along with the current set of
+ ;; active constraints for the block. The function returns a
+ ;; sequence of constraints; a constraint is a triplet of a
+ ;; constraint kind (a symbol, see (defstruct (constraint ...)) in
+ ;; constraint.lisp) and arguments, either LVARs, LAMBDA-VARs, or
+ ;; CTYPEs. If any of these arguments is NIL, the constraint is
+ ;; skipped. This simplifies integration with OK-LVAR-LAMBDA-VAR,
+ ;; which maps LVARs to LAMBDA-VARs. An optional fourth value in
+ ;; each constraint flips the meaning of the constraint if it is
+ ;; non-NIL.
+ (constraint-propagate nil :type (or function null))
+ ;; If true, the function can add flow-sensitive type information
+ ;; depending on the truthiness of its return value. Returns two
+ ;; values, a LVAR and a CTYPE. The LVAR is of that CTYPE iff the
+ ;; function returns true.
+ ;; It may also return additional third and fourth values. Each is
+ ;; a sequence of constraints (see CONSTRAINT-PROPAGATE), for the
+ ;; consequent and alternative branches, respectively.
+ (constraint-propagate-if nil :type (or function null))
;; all the templates that could be used to translate this function
;; into IR2, sorted by increasing cost.
(templates nil :type list)
(:derive-type (or function null))
(:optimizer (or function null))
(:destroyed-constant-args (or function null))
- (:result-arg (or index null)))
+ (:result-arg (or index null))
+ (:overwrite-fndb-silently boolean))
*)
%defknown))
-(defun %defknown (names type attributes &key derive-type optimizer destroyed-constant-args result-arg)
+(defun %defknown (names type attributes
+ &key derive-type optimizer destroyed-constant-args result-arg
+ overwrite-fndb-silently)
(let ((ctype (specifier-type type))
(info (make-fun-info :attributes attributes
:derive-type derive-type
:optimizer optimizer
:destroyed-constant-args destroyed-constant-args
- :result-arg result-arg))
- (target-env *info-environment*))
+ :result-arg result-arg)))
(dolist (name names)
- (let ((old-fun-info (info :function :info name)))
- (when old-fun-info
- ;; This is handled as an error because it's generally a bad
- ;; thing to blow away all the old optimization stuff. It's
- ;; also a potential source of sneaky bugs:
- ;; DEFKNOWN FOO
- ;; DEFTRANSFORM FOO
- ;; DEFKNOWN FOO ; possibly hidden inside some macroexpansion
- ;; ; Now the DEFTRANSFORM doesn't exist in the target Lisp.
- ;; However, it's continuable because it might be useful to do
- ;; it when testing new optimization stuff interactively.
- (cerror "Go ahead, overwrite it."
- "~@<overwriting old FUN-INFO ~2I~_~S ~I~_for ~S~:>"
- old-fun-info name)))
- (setf (info :function :type name target-env) ctype)
- (setf (info :function :where-from name target-env) :declared)
- (setf (info :function :kind name target-env) :function)
- (setf (info :function :info name target-env) info)))
+ (unless overwrite-fndb-silently
+ (let ((old-fun-info (info :function :info name)))
+ (when old-fun-info
+ ;; This is handled as an error because it's generally a bad
+ ;; thing to blow away all the old optimization stuff. It's
+ ;; also a potential source of sneaky bugs:
+ ;; DEFKNOWN FOO
+ ;; DEFTRANSFORM FOO
+ ;; DEFKNOWN FOO ; possibly hidden inside some macroexpansion
+ ;; ; Now the DEFTRANSFORM doesn't exist in the target Lisp.
+ ;; However, it's continuable because it might be useful to do
+ ;; it when testing new optimization stuff interactively.
+ (cerror "Go ahead, overwrite it."
+ "~@<overwriting old FUN-INFO ~2I~_~S ~I~_for ~S~:>"
+ old-fun-info name))))
+ (setf (info :function :type name) ctype)
+ (setf (info :function :where-from name) :declared)
+ (setf (info :function :kind name) :function)
+ (setf (info :function :info name) info)))
names)
;;; Return the FUN-INFO for NAME or die trying. Since this is
projects / sbcl.git / blobdiff