;;; Make the default keyword for a &KEY arg, checking that the keyword
;;; isn't already used by one of the VARS.
-(declaim (ftype (sfunction (symbol list t) keyword) make-keyword-for-arg))
+(declaim (ftype (sfunction (symbol list t) symbol) make-keyword-for-arg))
(defun make-keyword-for-arg (symbol vars keywordify)
(let ((key (if (and keywordify (not (keywordp symbol)))
(keywordicate symbol)
(let* ((bind (make-bind))
(lambda (make-lambda :vars vars
- :bind bind
- :%source-name source-name
- :%debug-name debug-name))
+ :bind bind
+ :%source-name source-name
+ :%debug-name debug-name))
(result (or result (make-continuation))))
- (continuation-starts-block result)
-
;; just to check: This function should fail internal assertions if
;; we didn't set up a valid debug name above.
;;
(setf (lambda-home lambda) lambda)
(collect ((svars)
- (new-venv nil cons))
+ (new-venv nil cons))
(dolist (var vars)
;; As far as I can see, LAMBDA-VAR-HOME should never have
(setf (bind-lambda bind) lambda)
(setf (node-lexenv bind) *lexenv*)
- (let ((cont1 (make-continuation))
- (cont2 (make-continuation)))
- (continuation-starts-block cont1)
- (link-node-to-previous-continuation bind cont1)
- (use-continuation bind cont2)
- (ir1-convert-special-bindings cont2 result body
- aux-vars aux-vals (svars)))
-
- (let ((block (continuation-block result)))
- (when block
- (let ((return (make-return :result result :lambda lambda))
- (tail-set (make-tail-set :funs (list lambda)))
- (dummy (make-continuation)))
- (setf (lambda-tail-set lambda) tail-set)
- (setf (lambda-return lambda) return)
- (setf (continuation-dest result) return)
- (flush-continuation-externally-checkable-type result)
- (setf (block-last block) return)
- (link-node-to-previous-continuation return result)
- (use-continuation return dummy))
- (link-blocks block (component-tail *current-component*))))))
+ (let ((block (continuation-starts-block result)))
+ (let ((return (make-return :result result :lambda lambda))
+ (tail-set (make-tail-set :funs (list lambda)))
+ (dummy (make-continuation)))
+ (setf (lambda-tail-set lambda) tail-set)
+ (setf (lambda-return lambda) return)
+ (setf (continuation-dest result) return)
+ (flush-continuation-externally-checkable-type result)
+ (setf (block-last block) return)
+ (link-node-to-previous-continuation return result)
+ (use-continuation return dummy))
+ (link-blocks block (component-tail *current-component*)))
+
+ (with-component-last-block (*current-component*
+ (continuation-block result))
+ (let ((cont1 (make-continuation))
+ (cont2 (make-continuation)))
+ (continuation-starts-block cont1)
+ (link-node-to-previous-continuation bind cont1)
+ (use-continuation bind cont2)
+ (ir1-convert-special-bindings cont2 result body
+ aux-vars aux-vals (svars))))))
(link-blocks (component-head *current-component*) (node-block bind))
(push lambda (component-new-functionals *current-component*))
(append aux-vars vars)
nil result-cont))
(forms (if (and *allow-debug-catch-tag*
- (policy *lexenv* (> debug (max speed space))))
+ (policy *lexenv* (= insert-debug-catch 3)))
`((catch (make-symbol "SB-DEBUG-CATCH-TAG")
,@forms))
forms))
;; compilation unit, so we can't do that. -- WHN 2001-02-11
:lossage-fun #'compiler-style-warn
:unwinnage-fun (cond (info #'compiler-style-warn)
- (for-real #'compiler-note)
+ (for-real #'compiler-notify)
(t nil))
:really-assert
(and for-real