;;; assumed that the call is legal and has only constants in the
;;; keyword positions.
(defun assert-call-type (call type)
- (declare (type combination call) (type function-type type))
- (derive-node-type call (function-type-returns type))
+ (declare (type combination call) (type fun-type type))
+ (derive-node-type call (fun-type-returns type))
(let ((args (combination-args call)))
- (dolist (req (function-type-required type))
+ (dolist (req (fun-type-required type))
(when (null args) (return-from assert-call-type))
(let ((arg (pop args)))
(assert-continuation-type arg req)))
- (dolist (opt (function-type-optional type))
+ (dolist (opt (fun-type-optional type))
(when (null args) (return-from assert-call-type))
(let ((arg (pop args)))
(assert-continuation-type arg opt)))
- (let ((rest (function-type-rest type)))
+ (let ((rest (fun-type-rest type)))
(when rest
(dolist (arg args)
(assert-continuation-type arg rest))))
- (dolist (key (function-type-keywords type))
+ (dolist (key (fun-type-keywords type))
(let ((name (key-info-name key)))
(do ((arg args (cddr arg)))
((null arg))
;; cross-compiler doesn't know how to evaluate it.
#+sb-xc-host
(let* ((ref (continuation-use (combination-fun node)))
- (fun (leaf-name (ref-leaf ref))))
- (fboundp fun)))
+ (fun-name (leaf-source-name (ref-leaf ref))))
+ (fboundp fun-name)))
(constant-fold-call node)
(return-from ir1-optimize-combination)))
#!+sb-show
(when *show-transforms-p*
(let* ((cont (basic-combination-fun node))
- (fname (continuation-function-name cont t)))
+ (fname (continuation-fun-name cont t)))
(/show "trying transform" x (transform-function x) "for" fname)))
(unless (ir1-transform node x)
#!+sb-show
;;; wondering if something should be done to special-case the call. If
;;; CALL is a call to a global function, then see whether it defined
;;; or known:
-;;; -- If a DEFINED-FUNCTION should be inline expanded, then convert
+;;; -- If a DEFINED-FUN should be inline expanded, then convert
;;; the expansion and change the call to call it. Expansion is
;;; enabled if :INLINE or if SPACE=0. If the FUNCTIONAL slot is
;;; true, we never expand, since this function has already been
(declare (type combination call))
(let* ((ref (continuation-use (basic-combination-fun call)))
(leaf (when (ref-p ref) (ref-leaf ref)))
- (inlinep (if (defined-function-p leaf)
- (defined-function-inlinep leaf)
+ (inlinep (if (defined-fun-p leaf)
+ (defined-fun-inlinep leaf)
:no-chance)))
(cond
((eq inlinep :notinline) (values nil nil))
(:inline t)
(:no-chance nil)
((nil :maybe-inline) (policy call (zerop space))))
- (defined-function-inline-expansion leaf)
- (let ((fun (defined-function-functional leaf)))
+ ;; FIXME: In sbcl-0.pre7.87, it looks as though we'll
+ ;; get here when LEAF is a GLOBAL-VAR (not a DEFINED-FUN)
+ ;; whenever (ZEROP SPACE), in which case we'll die with
+ ;; a type error when we try to access LEAF as a DEFINED-FUN.
+ (defined-fun-inline-expansion leaf)
+ (let ((fun (defined-fun-functional leaf)))
(or (not fun)
(and (eq inlinep :inline) (functional-kind fun))))
(inline-expansion-ok call))
(flet ((frob ()
(let ((res (ir1-convert-lambda-for-defun
- (defined-function-inline-expansion leaf)
+ (defined-fun-inline-expansion leaf)
leaf t
#'ir1-convert-inline-lambda)))
- (setf (defined-function-functional leaf) res)
+ (setf (defined-fun-functional leaf) res)
(change-ref-leaf ref res))))
(if ir1-p
(frob)
(values (ref-leaf (continuation-use (basic-combination-fun call)))
nil))
(t
- (let* ((name (leaf-name leaf))
+ (let* ((name (leaf-source-name leaf))
(info (info :function :info
(if (slot-accessor-p leaf)
- (if (consp name)
- '%slot-setter
- '%slot-accessor)
- name))))
+ (if (consp source-name) ; i.e. if SETF function
+ '%slot-setter
+ '%slot-accessor)
+ name))))
(if info
(values leaf (setf (basic-combination-kind call) info))
(values leaf nil)))))))
;;; and that checking is done by local call analysis.
(defun validate-call-type (call type ir1-p)
(declare (type combination call) (type ctype type))
- (cond ((not (function-type-p type))
+ (cond ((not (fun-type-p type))
(aver (multiple-value-bind (val win)
(csubtypep type (specifier-type 'function))
(or val (not win))))
(values nil nil))))
;;; This is called by IR1-OPTIMIZE when the function for a call has
-;;; changed. If the call is local, we try to let-convert it, and
+;;; changed. If the call is local, we try to LET-convert it, and
;;; derive the result type. If it is a :FULL call, we validate it
;;; against the type, which recognizes known calls, does inline
;;; expansion, etc. If a call to a predicate in a non-conditional
(continuation-use (basic-combination-fun call))
call))
((not leaf))
- ((or (info :function :source-transform (leaf-name leaf))
+ ((or (info :function :source-transform (leaf-source-name leaf))
(and info
(ir1-attributep (function-info-attributes info)
predicate)
(let ((dest (continuation-dest (node-cont call))))
(and dest (not (if-p dest))))))
- (let ((name (leaf-name leaf)))
- (when (symbolp name)
- (let ((dums (make-gensym-list (length
- (combination-args call)))))
- (transform-call call
- `(lambda ,dums
- (,name ,@dums))))))))))))
+ (when (and (leaf-has-source-name-p leaf)
+ ;; FIXME: This SYMBOLP is part of a literal
+ ;; translation of a test in the old CMU CL
+ ;; source, and it's not quite clear what
+ ;; the old source meant. Did it mean "has a
+ ;; valid name"? Or did it mean "is an
+ ;; ordinary function name, not a SETF
+ ;; function"? Either way, the old CMU CL
+ ;; code probably didn't deal with SETF
+ ;; functions correctly, and neither does
+ ;; this new SBCL code, and that should be fixed.
+ (symbolp (leaf-source-name leaf)))
+ (let ((dummies (make-gensym-list (length
+ (combination-args call)))))
+ (transform-call call
+ `(lambda ,dummies
+ (,(leaf-source-name leaf)
+ ,@dummies)))))))))))
(values))
\f
;;;; known function optimization
;;; replace it, otherwise add a new one.
(defun record-optimization-failure (node transform args)
(declare (type combination node) (type transform transform)
- (type (or function-type list) args))
+ (type (or fun-type list) args))
(let* ((table (component-failed-optimizations *component-being-compiled*))
(found (assoc transform (gethash node table))))
(if found
(declare (type combination node) (type transform transform))
(let* ((type (transform-type transform))
(fun (transform-function transform))
- (constrained (function-type-p type))
+ (constrained (fun-type-p type))
(table (component-failed-optimizations *component-being-compiled*))
(flame (if (transform-important transform)
(policy node (>= speed inhibit-warnings))
(defun transform-call (node res)
(declare (type combination node) (list res))
(with-ir1-environment node
- (let ((new-fun (ir1-convert-inline-lambda res))
+ (let ((new-fun (ir1-convert-inline-lambda
+ res
+ :debug-name "<something inlined in TRANSFORM-CALL>"))
(ref (continuation-use (combination-fun node))))
(change-ref-leaf ref new-fun)
(setf (combination-kind node) :full)
;;; Replace a call to a foldable function of constant arguments with
;;; the result of evaluating the form. We insert the resulting
;;; constant node after the call, stealing the call's continuation. We
-;;; give the call a continuation with no Dest, which should cause it
+;;; give the call a continuation with no DEST, which should cause it
;;; and its arguments to go away. If there is an error during the
;;; evaluation, we give a warning and leave the call alone, making the
;;; call a :ERROR call.
(declare (type combination call))
(let* ((args (mapcar #'continuation-value (combination-args call)))
(ref (continuation-use (combination-fun call)))
- (fun (leaf-name (ref-leaf ref))))
+ (fun-name (leaf-source-name (ref-leaf ref))))
(multiple-value-bind (values win)
- (careful-call fun args call "constant folding")
+ (careful-call fun-name args call "constant folding")
(if (not win)
(setf (combination-kind call) :error)
(let ((dummies (make-gensym-list (length args))))
(defun propagate-to-refs (leaf type)
(declare (type leaf leaf) (type ctype type))
(let ((var-type (leaf-type leaf)))
- (unless (function-type-p var-type)
+ (unless (fun-type-p var-type)
(let ((int (type-approx-intersection2 var-type type)))
(when (type/= int var-type)
(setf (leaf-type leaf) int)
((or constant functional) t)
(lambda-var
(null (lambda-var-sets leaf)))
- (defined-function
- (not (eq (defined-function-inlinep leaf) :notinline)))
+ (defined-fun
+ (not (eq (defined-fun-inlinep leaf) :notinline)))
(global-var
(case (global-var-kind leaf)
- (:global-function t)
- (:constant t))))))
+ (:global-function t))))))
;;; If we have a non-set LET var with a single use, then (if possible)
;;; replace the variable reference's CONT with the arg continuation.
;;;
;;; Substitution of individual references is inhibited if the
;;; reference is in a different component from the home. This can only
-;;; happen with closures over top-level lambda vars. In such cases,
+;;; happen with closures over top level lambda vars. In such cases,
;;; the references may have already been compiled, and thus can't be
;;; retroactively modified.
;;;
t)
(t
(aver (eq (functional-kind (lambda-home fun))
- :top-level))
+ :toplevel))
nil)))
leaf var))
t)))))
(when fun-changed
(setf (continuation-reoptimize fun) nil)
(let ((type (continuation-type fun)))
- (when (function-type-p type)
- (derive-node-type node (function-type-returns type))))
+ (when (fun-type-p type)
+ (derive-node-type node (fun-type-returns type))))
(maybe-terminate-block node nil)
(let ((use (continuation-use fun)))
(when (and (ref-p use) (functional-p (ref-leaf use)))
(when (eq (basic-combination-kind node) :local)
(maybe-let-convert (ref-leaf use))))))
(unless (or (eq (basic-combination-kind node) :local)
- (eq (continuation-function-name fun) '%throw))
+ (eq (continuation-fun-name fun) '%throw))
(ir1-optimize-mv-call node))
(dolist (arg args)
(setf (continuation-reoptimize arg) nil))))
(return-from ir1-optimize-mv-call))
(multiple-value-bind (min max)
- (function-type-nargs (continuation-type fun))
+ (fun-type-nargs (continuation-type fun))
(let ((total-nvals
(multiple-value-bind (types nvals)
(values-types (continuation-derived-type (first args)))
(let* ((arg (first (basic-combination-args call)))
(use (continuation-use arg)))
(when (and (combination-p use)
- (eq (continuation-function-name (combination-fun use))
+ (eq (continuation-fun-name (combination-fun use))
'values))
(let* ((fun (combination-lambda call))
(vars (lambda-vars fun))
(defoptimizer (values-list optimizer) ((list) node)
(let ((use (continuation-use list)))
(when (and (combination-p use)
- (eq (continuation-function-name (combination-fun use))
+ (eq (continuation-fun-name (combination-fun use))
'list))
(change-ref-leaf (continuation-use (combination-fun node))
(find-free-function 'values "in a strange place"))
projects / sbcl.git / blobdiff