(unless (symbolp name)
(fail "The local macro name ~S is not a symbol." name))
(when (fboundp name)
- (compiler-assert-symbol-home-package-unlocked
- name "binding ~A as a local macro"))
+ (program-assert-symbol-home-package-unlocked
+ context name "binding ~A as a local macro"))
(unless (listp arglist)
(fail "The local macro argument list ~S is not a list."
arglist))
(unless (symbolp name)
(fail "The local symbol macro name ~S is not a symbol." name))
(when (or (boundp name) (eq (info :variable :kind name) :macro))
- (compiler-assert-symbol-home-package-unlocked
- name "binding ~A as a local symbol-macro"))
+ (program-assert-symbol-home-package-unlocked
+ context name "binding ~A as a local symbol-macro"))
(let ((kind (info :variable :kind name)))
(when (member kind '(:special :constant))
(fail "Attempt to bind a ~(~A~) variable with SYMBOL-MACROLET: ~S"
(dolist (lambda lambdas)
(setf (functional-allocator lambda) allocator)))))
-(defmacro with-fun-name-leaf ((leaf thing start) &body body)
- `(multiple-value-bind (,leaf allocate-p) (fun-name-leaf ,thing)
+(defmacro with-fun-name-leaf ((leaf thing start &key global) &body body)
+ `(multiple-value-bind (,leaf allocate-p)
+ (if ,global
+ (find-global-fun ,thing t)
+ (fun-name-leaf ,thing))
(if allocate-p
- (let ((.new-start. (make-ctran)))
- (ir1-convert ,start .new-start. nil `(%%allocate-closures ,leaf))
- (let ((,start .new-start.))
- ,@body))
- (locally
- ,@body))))
+ (let ((.new-start. (make-ctran)))
+ (ir1-convert ,start .new-start. nil `(%%allocate-closures ,leaf))
+ (let ((,start .new-start.))
+ ,@body))
+ (locally
+ ,@body))))
(def-ir1-translator function ((thing) start next result)
#!+sb-doc
be a lambda expression."
(with-fun-name-leaf (leaf thing start)
(reference-leaf start next result leaf)))
+
+;;; Like FUNCTION, but ignores local definitions and inline
+;;; expansions, and doesn't nag about undefined functions.
+;;; Used for optimizing things like (FUNCALL 'FOO).
+(def-ir1-translator global-function ((thing) start next result)
+ (with-fun-name-leaf (leaf thing start :global t)
+ (reference-leaf start next result leaf)))
+
+(defun constant-global-fun-name (thing)
+ (let ((constantp (sb!xc:constantp thing)))
+ (and constantp
+ (let ((name (constant-form-value thing)))
+ (and (legal-fun-name-p name) name)))))
\f
;;;; FUNCALL
,@arg-names))))
(def-ir1-translator %funcall ((function &rest args) start next result)
- (if (and (consp function) (eq (car function) 'function))
- (with-fun-name-leaf (leaf (second function) start)
- (ir1-convert start next result `(,leaf ,@args)))
- (let ((ctran (make-ctran))
- (fun-lvar (make-lvar)))
- (ir1-convert start ctran fun-lvar `(the function ,function))
- (ir1-convert-combination-args fun-lvar ctran next result args))))
+ (cond ((and (consp function) (eq (car function) 'function))
+ (with-fun-name-leaf (leaf (second function) start)
+ (ir1-convert start next result `(,leaf ,@args))))
+ ((and (consp function) (eq (car function) 'global-function))
+ (with-fun-name-leaf (leaf (second function) start :global t)
+ (ir1-convert start next result `(,leaf ,@args))))
+ (t
+ (let ((ctran (make-ctran))
+ (fun-lvar (make-lvar)))
+ (ir1-convert start ctran fun-lvar `(the function ,function))
+ (ir1-convert-combination-args fun-lvar ctran next result args)))))
;;; This source transform exists to reduce the amount of work for the
;;; compiler. If the called function is a FUNCTION form, then convert
(define-source-transform funcall (function &rest args)
(if (and (consp function) (eq (car function) 'function))
`(%funcall ,function ,@args)
- (values nil t)))
+ (let ((name (constant-global-fun-name function)))
+ (if name
+ `(%funcall (global-function ,name) ,@args)
+ (values nil t)))))
(deftransform %coerce-callable-to-fun ((thing) (function) *)
"optimize away possible call to FDEFINITION at runtime"
(vals (second spec)))))))
(dolist (name (names))
(when (eq (info :variable :kind name) :macro)
- (compiler-assert-symbol-home-package-unlocked
- name "lexically binding symbol-macro ~A")))
+ (program-assert-symbol-home-package-unlocked
+ :compile name "lexically binding symbol-macro ~A")))
(values (vars) (vals))))
(def-ir1-translator let ((bindings &body body) start next result)
(let ((name (first def)))
(check-fun-name name)
(when (fboundp name)
- (compiler-assert-symbol-home-package-unlocked
- name "binding ~A as a local function"))
+ (program-assert-symbol-home-package-unlocked
+ :compile name "binding ~A as a local function"))
(names name)
(multiple-value-bind (forms decls) (parse-body (cddr def))
(defs `(lambda ,(second def)
(ir1-convert start ctran fun-lvar
(if (and (consp fun) (eq (car fun) 'function))
fun
- `(%coerce-callable-to-fun ,fun)))
+ (let ((name (constant-global-fun-name fun)))
+ (if name
+ `(global-function ,name)
+ `(%coerce-callable-to-fun ,fun)))))
(setf (lvar-dest fun-lvar) node)
(collect ((arg-lvars))
(let ((this-start ctran))