cont
(ir1-convert-lambda thing
:debug-name (debug-namify
- "#'~S" thing))))
+ "#'~S" thing)
+ :allow-debug-catch-tag t)))
((setf)
(let ((var (find-lexically-apparent-fun
thing "as the argument to FUNCTION")))
((instance-lambda)
(let ((res (ir1-convert-lambda `(lambda ,@(cdr thing))
:debug-name (debug-namify "#'~S"
- thing))))
+ thing)
+ :allow-debug-catch-tag t)))
(setf (getf (functional-plist res) :fin-function) t)
(reference-leaf start cont res)))
(t
(def-ir1-translator named-lambda ((name &rest rest) start cont)
(let* ((fun (if (legal-fun-name-p name)
(ir1-convert-lambda `(lambda ,@rest)
- :source-name name)
+ :source-name name
+ :allow-debug-catch-tag t)
(ir1-convert-lambda `(lambda ,@rest)
- :debug-name name)))
+ :debug-name name
+ :allow-debug-catch-tag t)))
(leaf (reference-leaf start cont fun)))
(when (legal-fun-name-p name)
(assert-global-function-definition-type name fun))
(ir1-convert-lambda d
:source-name n
:debug-name (debug-namify
- "FLET ~S" n)))
+ "FLET ~S" n)
+ :allow-debug-catch-tag t))
names defs))
(*lexenv* (make-lexenv
:default (process-decls decls nil fvars cont)
(ir1-convert-lambda def
:source-name name
:debug-name (debug-namify
- "LABELS ~S" name)))
+ "LABELS ~S" name)
+ :allow-debug-catch-tag t))
names defs))))
;; Modify all the references to the dummy function leaves so
(defun setq-var (start cont var value)
(declare (type continuation start cont) (type basic-var var))
(let ((dest (make-continuation)))
- (assert-continuation-type dest (leaf-type var) (lexenv-policy *lexenv*))
(ir1-convert start dest value)
+ (assert-continuation-type dest (leaf-type var) (lexenv-policy *lexenv*))
(let ((res (make-set :var var :value dest)))
(setf (continuation-dest dest) res)
(setf (leaf-ever-used var) t)
\f
;;;; CATCH, THROW and UNWIND-PROTECT
-;;; We turn THROW into a multiple-value-call of a magical function,
+;;; We turn THROW into a MULTIPLE-VALUE-CALL of a magical function,
;;; since as as far as IR1 is concerned, it has no interesting
;;; properties other than receiving multiple-values.
(def-ir1-translator throw ((tag result) start cont)