;; IR1-CONVERT-MAYBE-PREDICATE requires DEST to be CIF, so the
;; order of the following two forms is important
(setf (lvar-dest pred-lvar) node)
- (ir1-convert start pred-ctran pred-lvar test)
+ (multiple-value-bind (context count) (possible-rest-arg-context test)
+ (if context
+ (ir1-convert start pred-ctran pred-lvar `(%rest-true ,test ,context ,count))
+ (ir1-convert start pred-ctran pred-lvar test)))
(link-node-to-previous-ctran node pred-ctran)
(let ((start-block (ctran-block pred-ctran)))
#!+sb-doc
"TAGBODY {tag | statement}*
-Define tags for use with GO. The STATEMENTS are evaluated in order ,skipping
+Define tags for use with GO. The STATEMENTS are evaluated in order, skipping
TAGS, and NIL is returned. If a statement contains a GO to a defined TAG
within the lexical scope of the form, then control is transferred to the next
-statement following that tag. A TAG must an integer or a symbol. A STATEMENT
-must be a list. Other objects are illegal within the body."
+statement following that tag. A TAG must be an integer or a symbol. A
+STATEMENT must be a list. Other objects are illegal within the body."
(start-block start)
(ctran-starts-block next)
(let* ((dummy (make-ctran))
"MACROLET ({(name lambda-list form*)}*) body-form*
Evaluate the BODY-FORMS in an environment with the specified local macros
-defined. Name is the local macro name, LAMBDA-LIST is a DEFMACRO style
+defined. NAME is the local macro name, LAMBDA-LIST is a DEFMACRO style
destructuring lambda list, and the FORMS evaluate to the expansion."
(funcall-in-macrolet-lexenv
definitions
;; Name of the outermost non-NIL BLOCK, or the source namestring
;; of the source file.
(let ((context
- (or (car (find-if #'car (lexenv-blocks *lexenv*) :from-end t))
+ (or (car (find-if (lambda (b)
+ (let ((name (pop b)))
+ (and name
+ ;; KLUDGE: High debug adds this block on
+ ;; some platforms.
+ #!-unwind-to-frame-and-call-vop
+ (neq 'return-value-tag name)
+ ;; KLUDGE: CATCH produces blocks whose
+ ;; cleanup is :CATCH.
+ (neq :catch (cleanup-kind (entry-cleanup (pop b)))))))
+ (lexenv-blocks *lexenv*) :from-end t))
*source-namestring*
(let ((p (or *compile-file-truename* *load-truename*)))
(when p (namestring p))))))