(defun annotate-1-value-continuation (cont)
(declare (type continuation cont))
(let ((info (continuation-info cont)))
- (assert (eq (ir2-continuation-kind info) :fixed))
+ (aver (eq (ir2-continuation-kind info) :fixed))
(cond
((continuation-delayed-leaf cont)
(setf (ir2-continuation-kind info) :delayed))
(defun set-tail-local-call-successor (call)
(let ((caller (node-home-lambda call))
(callee (combination-lambda call)))
- (assert (eq (lambda-tail-set caller)
- (lambda-tail-set (lambda-home callee))))
+ (aver (eq (lambda-tail-set caller)
+ (lambda-tail-set (lambda-home callee))))
(node-ends-block call)
(let ((block (node-block call)))
(unlink-blocks block (first (block-succ block)))
(defoptimizer (%unwind-protect ltn-annotate) ((escape cleanup)
node
ltn-policy)
- (declare (ignore ltn-policy))
+ ltn-policy ; a hack to effectively (DECLARE (IGNORE LTN-POLICY))
(setf (basic-combination-info node) :funny)
(setf (node-tail-p node) nil))
(funcall frob "This shouldn't happen! Bug?")
(multiple-value-bind (win why)
(is-ok-template-use template call (ltn-policy-safe-p ltn-policy))
- (assert (not win))
+ (aver (not win))
(ecase why
(:guard
(funcall frob "template guard failed"))
(and (template-note try)
(valid-function-use
call (template-type try)
- :argument-test #'types-intersect
- :result-test #'values-types-intersect))))
+ :argument-test #'types-equal-or-intersect
+ :result-test
+ #'values-types-equal-or-intersect))))
(losers try)))))
(when (losers)
((and valid strict-valid)
(strange-template-failure loser call ltn-policy #'frob))
((not valid)
- (assert (not (valid-function-use call type
- :error-function #'frob
- :warning-function #'frob))))
+ (aver (not (valid-function-use call type
+ :error-function #'frob
+ :warning-function #'frob))))
(t
- (assert (ltn-policy-safe-p ltn-policy))
+ (aver (ltn-policy-safe-p ltn-policy))
(frob "can't trust output type assertion under safe policy")))
(count 1))))
(when (and rejected
(policy call (> speed inhibit-warnings)))
(note-rejected-templates call ltn-policy template))
- ;; If we are forced to do a full call, we check to see whether the
- ;; function called is the same as the current function. If so, we
- ;; give a warning, as this is probably a botched interpreter stub.
+ ;; If we are forced to do a full call, we check to see whether
+ ;; the function called is the same as the current function. If
+ ;; so, we give a warning, as this is probably a botched attempt
+ ;; to implement an out-of-line version in terms of inline
+ ;; transforms or VOPs or whatever.
(unless template
(when (and (eq (continuation-function-name (combination-fun call))
(leaf-name
(ir1-attributep (function-info-attributes info)
recursive)))))
(let ((*compiler-error-context* call))
- (compiler-warning "recursive known function definition")))
+ (compiler-warning "~@<recursion in known function definition~2I ~
+ ~_policy=~S ~_arg types=~S~:>"
+ (lexenv-policy (node-lexenv call))
+ (mapcar (lambda (arg)
+ (type-specifier (continuation-type
+ arg)))
+ args))))
(ltn-default-call call ltn-policy)
(return-from ltn-analyze-known-call (values)))
(setf (basic-combination-info call) template)
(declare (type component component))
(let ((2comp (component-info component)))
(do-blocks (block component)
- (assert (not (block-info block)))
+ (aver (not (block-info block)))
(let ((2block (make-ir2-block block)))
(setf (block-info block) 2block)
(ltn-analyze-block block)
(defun ltn-analyze-belated-block (block)
(declare (type cblock block))
(ltn-analyze-block block)
- (assert (not (ir2-block-popped (block-info block))))
+ (aver (not (ir2-block-popped (block-info block))))
(values))