;;; names a macro or special form, then we error out using the
;;; supplied context which indicates what we were trying to do that
;;; demanded a function.
-(declaim (ftype (function (t string) global-var) find-free-fun))
+(declaim (ftype (sfunction (t string) global-var) find-free-fun))
(defun find-free-fun (name context)
(or (let ((old-free-fun (gethash name *free-funs*)))
(and (not (invalid-free-fun-p old-free-fun))
;;; Return the LEAF structure for the lexically apparent function
;;; definition of NAME.
-(declaim (ftype (function (t string) leaf) find-lexically-apparent-fun))
+(declaim (ftype (sfunction (t string) leaf) find-lexically-apparent-fun))
(defun find-lexically-apparent-fun (name context)
(let ((var (lexenv-find name funs :test #'equal)))
(cond (var
;;; corresponding value. Otherwise, we make a new leaf using
;;; information from the global environment and enter it in
;;; *FREE-VARS*. If the variable is unknown, then we emit a warning.
-(declaim (ftype (function (t) (or leaf cons heap-alien-info)) find-free-var))
+(declaim (ftype (sfunction (t) (or leaf cons heap-alien-info)) find-free-var))
(defun find-free-var (name)
(unless (symbolp name)
(compiler-error "Variable name is not a symbol: ~S." name))
\f
;;;; IR1-CONVERT, macroexpansion and special form dispatching
+(declaim (ftype (sfunction (continuation continuation t) (values))
+ ir1-convert))
(macrolet (;; Bind *COMPILER-ERROR-BAILOUT* to a function that throws
;; out of the body and converts a proxy form instead.
(ir1-error-bailout ((start
;; the creation using backquote of forms that contain leaf
;; references, without having to introduce dummy names into the
;; namespace.
- (declaim (ftype (function (continuation continuation t) (values)) ir1-convert))
(defun ir1-convert (start cont form)
(ir1-error-bailout (start cont form)
(let ((*current-path* (or (gethash form *source-paths*)
;;; functional instead.
(defun reference-leaf (start cont leaf)
(declare (type continuation start cont) (type leaf leaf))
+ (when (functional-p leaf)
+ (assure-functional-live-p leaf))
(let* ((type (lexenv-find leaf type-restrictions))
(leaf (or (and (defined-fun-p leaf)
(not (eq (defined-fun-inlinep leaf)
;; WHN 19990412
#+(and cmu sb-xc-host)
(warning (lambda (c)
- (compiler-note
+ (compiler-notify
"~@<~A~:@_~
~A~:@_~
~@<(KLUDGE: That was a non-STYLE WARNING. ~
;;; Convert a bunch of forms, discarding all the values except the
;;; last. If there aren't any forms, then translate a NIL.
-(declaim (ftype (function (continuation continuation list) (values))
+(declaim (ftype (sfunction (continuation continuation list) (values))
ir1-convert-progn-body))
(defun ir1-convert-progn-body (start cont body)
(if (endp body)
;;; Convert a function call where the function FUN is a LEAF. FORM is
;;; the source for the call. We return the COMBINATION node so that
;;; the caller can poke at it if it wants to.
-(declaim (ftype (function (continuation continuation list leaf) combination)
+(declaim (ftype (sfunction (continuation continuation list leaf) combination)
ir1-convert-combination))
(defun ir1-convert-combination (start cont form fun)
(let ((fun-cont (make-continuation)))
(let ((transform (info :function
:source-transform
(leaf-source-name var))))
- (if transform
- (multiple-value-bind (result pass) (funcall transform form)
- (if pass
- (ir1-convert-maybe-predicate start cont form var)
+ (if transform
+ (multiple-value-bind (result pass) (funcall transform form)
+ (if pass
+ (ir1-convert-maybe-predicate start cont form var)
(ir1-convert start cont result)))
- (ir1-convert-maybe-predicate start cont form var))))))
+ (ir1-convert-maybe-predicate start cont form var))))))
;;; If the function has the PREDICATE attribute, and the CONT's DEST
;;; isn't an IF, then we convert (IF <form> T NIL), ensuring that a
;;; are converting inline expansions for local functions during
;;; optimization.
(defun ir1-convert-local-combination (start cont form functional)
-
- ;; The test here is for "when LET converted", as a translation of
- ;; the old CMU CL comments into code. Unfortunately, the old CMU CL
- ;; comments aren't specific enough to tell whether the correct
- ;; translation is FUNCTIONAL-SOMEWHAT-LETLIKE-P or
- ;; FUNCTIONAL-LETLIKE-P or what. The old CMU CL code assumed that
- ;; any non-null FUNCTIONAL-KIND meant that the function "had been
- ;; LET converted", which might even be right, but seems fragile, so
- ;; we try to be pickier.
- (when (or
- ;; looks LET-converted
- (functional-somewhat-letlike-p functional)
- ;; It's possible for a LET-converted function to end up
- ;; deleted later. In that case, for the purposes of this
- ;; analysis, it is LET-converted: LET-converted functionals
- ;; are too badly trashed to expand them inline, and deleted
- ;; LET-converted functionals are even worse.
- (eql (functional-kind functional) :deleted))
- (throw 'locall-already-let-converted functional))
- ;; Any other non-NIL KIND value is a case we haven't found a
- ;; justification for, and at least some such values (e.g. :EXTERNAL
- ;; and :TOPLEVEL) seem obviously wrong.
- (aver (null (functional-kind functional)))
-
+ (assure-functional-live-p functional)
(ir1-convert-combination start
cont
form
;;; LAMBDA-VAR for that name, or NIL if it isn't found. We return the
;;; *last* variable with that name, since LET* bindings may be
;;; duplicated, and declarations always apply to the last.
-(declaim (ftype (function (list symbol) (or lambda-var list))
+(declaim (ftype (sfunction (list symbol) (or lambda-var list))
find-in-bindings))
(defun find-in-bindings (vars name)
(let ((found nil))
(found
(setf (leaf-type found) type)
(assert-definition-type found type
- :unwinnage-fun #'compiler-note
+ :unwinnage-fun #'compiler-notify
:where "FTYPE declaration"))
(t
(res (cons (find-lexically-apparent-fun
(let ((res (make-defined-fun
:%source-name (leaf-source-name var)
:where-from (leaf-where-from var)
- :type (if (eq inlinep :notinline)
+ :type (if (and (eq inlinep :notinline)
+ (not (eq (leaf-where-from var) :declared)))
(specifier-type 'function)
(leaf-type var))
:inlinep inlinep)))
(etypecase found
(functional
(when (policy *lexenv* (>= speed inhibit-warnings))
- (compiler-note "ignoring ~A declaration not at ~
- definition of local function:~% ~S"
- sense name)))
+ (compiler-notify "ignoring ~A declaration not at ~
+ definition of local function:~% ~S"
+ sense name)))
(global-var
(push (cons name (make-new-inlinep found sense))
new-fenv)))))))
"in VALUES declaration"))))
(dynamic-extent
(when (policy *lexenv* (> speed inhibit-warnings))
- (compiler-note
+ (compiler-notify
"compiler limitation: ~
~% There's no special support for DYNAMIC-EXTENT (so it's ignored)."))
res)