(with-ir1-environment-from-node (lambda-bind (main-entry fun))
(let ((res (ir1-convert-lambda (make-xep-lambda-expression fun)
:debug-name (debug-namify
- "XEP for ~A"
+ "XEP for "
(leaf-debug-name fun)))))
(setf (functional-kind res) :external
(leaf-ever-used res) t
(return))
(let ((kind (functional-kind functional)))
(cond ((or (functional-somewhat-letlike-p functional)
- (eql kind :deleted))
+ (memq kind '(:deleted :zombie)))
(values)) ; nothing to do
((and (null (leaf-refs functional)) (eq kind nil)
(not (functional-entry-fun functional)))
(ir1-convert-lambda
(functional-inline-expansion original-functional)
:debug-name (debug-namify
- "local inline ~A"
+ "local inline "
(leaf-debug-name
original-functional)))))))
(cond (losing-local-functional
(cond ((= n-call-args nargs)
(convert-call ref call fun))
(t
- ;; FIXME: ANSI requires in "3.2.5 Exceptional Situations in the
- ;; Compiler" that calling a function with "the wrong number of
- ;; arguments" be only a STYLE-ERROR. I think, though, that this
- ;; should only apply when the number of arguments is inferred
- ;; from a previous definition. If the number of arguments
- ;; is DECLAIMed, surely calling with the wrong number is a
- ;; real WARNING. As long as SBCL continues to use CMU CL's
- ;; non-ANSI DEFUN-is-a-DECLAIM policy, we're in violation here,
- ;; but as long as we continue to use that policy, that's the
- ;; not our biggest problem.:-| When we fix that policy, this
- ;; should come back into compliance. (So fix that policy!)
- ;; ..but..
- ;; FIXME, continued: Except that section "3.2.2.3 Semantic
- ;; Constraints" says that if it's within the same file, it's
- ;; wrong. And we're in locall.lisp here, so it's probably
- ;; (haven't checked this..) a call to something in the same
- ;; file. So maybe it deserves a full warning anyway.
- (compiler-warn
+ (warn
+ 'local-argument-mismatch
+ :format-control
"function called with ~R argument~:P, but wants exactly ~R"
- n-call-args nargs)
+ :format-arguments (list n-call-args nargs))
(setf (basic-combination-kind call) :error)))))
\f
;;;; &OPTIONAL, &MORE and &KEYWORD calls
(max-args (optional-dispatch-max-args fun))
(call-args (length (combination-args call))))
(cond ((< call-args min-args)
- ;; FIXME: See FIXME note at the previous
- ;; wrong-number-of-arguments warnings in this file.
- (compiler-warn
+ (warn
+ 'local-argument-mismatch
+ :format-control
"function called with ~R argument~:P, but wants at least ~R"
- call-args min-args)
+ :format-arguments (list call-args min-args))
(setf (basic-combination-kind call) :error))
((<= call-args max-args)
(convert-call ref call
((optional-dispatch-more-entry fun)
(convert-more-call ref call fun))
(t
- ;; FIXME: See FIXME note at the previous
- ;; wrong-number-of-arguments warnings in this file.
- (compiler-warn
+ (warn
+ 'local-argument-mismatch
+ :format-control
"function called with ~R argument~:P, but wants at most ~R"
- call-args max-args)
+ :format-arguments
+ (list call-args max-args))
(setf (basic-combination-kind call) :error))))
(values))
`(lambda ,vars
(declare (ignorable ,@ignores))
(%funcall ,entry ,@args))
- :debug-name (debug-namify "hairy function entry ~S"
+ :debug-name (debug-namify "hairy function entry "
(lvar-fun-name
(basic-combination-fun call)))))))
(convert-call ref call new-fun)
(progn
(ignores dummy val)
(unless (eq name :allow-other-keys)
- (setq loser name))))
+ (setq loser (list name)))))
(let ((info (lambda-var-arg-info var)))
(when (eq (arg-info-key info) name)
(ignores dummy)
(when (and loser (not (optional-dispatch-allowp fun)) (not allowp))
(compiler-warn "function called with unknown argument keyword ~S"
- loser)
+ (car loser))
(setf (basic-combination-kind call) :error)
(return-from convert-more-call)))
next-block)))
(move-return-stuff fun call next-block)
(merge-lets fun call)
- (setf (node-tail-p call) nil)))
+ (setf (node-tail-p call) nil)
+ ;; If CALL has a derive type NIL, it means that "its return" is
+ ;; unreachable, but the next BIND is still reachable; in order to
+ ;; not confuse MAYBE-TERMINATE-BLOCK...
+ (setf (node-derived-type call) *wild-type*)))
;;; Reoptimize all of CALL's args and its result.
(defun reoptimize-call (call)