(let* ((bind-block (node-block bind))
(component (block-component bind-block))
(return (lambda-return clambda)))
- (aver (null (leaf-refs clambda)))
+ (dolist (ref (lambda-refs clambda))
+ (let ((home (node-home-lambda ref)))
+ (aver (eq home clambda))))
(unless (leaf-ever-used clambda)
(let ((*compiler-error-context* bind))
(compiler-note "deleting unused function~:[.~;~:*~% ~S~]"
;;; Apply a function to some arguments, returning a list of the values
;;; resulting of the evaluation. If an error is signalled during the
-;;; application, then we print a warning message and return NIL as our
-;;; second value to indicate this. Node is used as the error context
-;;; for any error message, and Context is a string that is spliced
-;;; into the warning.
-(declaim (ftype (function ((or symbol function) list node string)
+;;; application, then we produce a warning message using WARN-FUN and
+;;; return NIL as our second value to indicate this. NODE is used as
+;;; the error context for any error message, and CONTEXT is a string
+;;; that is spliced into the warning.
+(declaim (ftype (function ((or symbol function) list node function string)
(values list boolean))
careful-call))
-(defun careful-call (function args node context)
+(defun careful-call (function args node warn-fun context)
(values
(multiple-value-list
(handler-case (apply function args)
(error (condition)
(let ((*compiler-error-context* node))
- (compiler-warn "Lisp error during ~A:~%~A" context condition)
+ (funcall warn-fun "Lisp error during ~A:~%~A" context condition)
(return-from careful-call (values nil nil))))))
t))
+
+;;; Variations of SPECIFIER-TYPE for parsing possibly wrong
+;;; specifiers.
+(macrolet
+ ((deffrob (basic careful compiler transform)
+ `(progn
+ (defun ,careful (specifier)
+ (handler-case (,basic specifier)
+ (simple-error (condition)
+ (values nil (list* (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition))))))
+ (defun ,compiler (specifier)
+ (multiple-value-bind (type error-args) (,careful specifier)
+ (or type
+ (apply #'compiler-error error-args))))
+ (defun ,transform (specifier)
+ (multiple-value-bind (type error-args) (,careful specifier)
+ (or type
+ (apply #'give-up-ir1-transform
+ error-args)))))))
+ (deffrob specifier-type careful-specifier-type compiler-specifier-type ir1-transform-specifier-type)
+ (deffrob values-specifier-type careful-values-specifier-type compiler-values-specifier-type ir1-transform-values-specifier-type))
+
\f
;;;; utilities used at run-time for parsing &KEY args in IR1