(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"
(with-fun-name-leaf (leaf thing start :global t)
(reference-leaf start next result leaf)))
-(defun constant-global-fun-name-p (thing)
- ;; FIXME: Once we have a marginally better CONSTANTP and
- ;; CONSTANT-VALUE we can use those instead.
- (and (consp thing)
- (eq 'quote (car thing))
- (null (cddr thing))
- (legal-fun-name-p (cadr thing))
- t))
+(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
;;; directly to %FUNCALL, instead of waiting around for type
;;; inference.
(define-source-transform funcall (function &rest args)
- (cond ((and (consp function) (eq (car function) 'function))
- `(%funcall ,function ,@args))
- ((constant-global-fun-name-p function)
- `(%funcall (global-function ,(second function)) ,@args))
- (t
- (values nil t))))
+ (if (and (consp function) (eq (car function) 'function))
+ `(%funcall ,function ,@args)
+ (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)
;; MV-COMBINATIONS.
(make-combination fun-lvar))))
(ir1-convert start ctran fun-lvar
- (cond ((and (consp fun) (eq (car fun) 'function))
- fun)
- ((constant-global-fun-name-p fun)
- `(global-function ,(second fun)))
- (t
- `(%coerce-callable-to-fun ,fun))))
+ (if (and (consp fun) (eq (car fun) 'function))
+ 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))