Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5471:00e79bbbe48f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Mon, 14 Feb 2011 22:43:46 +0100
parents 0af042a0c116 5dd1ba5e0113
children ac37a5f7e5be
comparison
equal deleted inserted replaced
5470:0af042a0c116 5471:00e79bbbe48f
743 references may appear inside macro expansions and in lambda expressions, but 743 references may appear inside macro expansions and in lambda expressions, but
744 not inside other functions called from BODY." 744 not inside other functions called from BODY."
745 (let ((cl-active-block-names (acons name (copy-symbol name) 745 (let ((cl-active-block-names (acons name (copy-symbol name)
746 cl-active-block-names)) 746 cl-active-block-names))
747 (body (cons 'progn body))) 747 (body (cons 'progn body)))
748 ;; Tell the byte-compiler this is a block, not a normal catch call, and
749 ;; as such it can eliminate it if that's appropriate:
750 (put (cdar cl-active-block-names) 'cl-block-name name)
748 `(catch ',(cdar cl-active-block-names) 751 `(catch ',(cdar cl-active-block-names)
749 ,(cl-macroexpand-all body cl-macro-environment)))) 752 ,(cl-macroexpand-all body cl-macro-environment))))
750 753
751 ;;;###autoload 754 ;;;###autoload
752 (defmacro return (&optional result) 755 (defmacro return (&optional result)
759 "Return from the block named NAME. 762 "Return from the block named NAME.
760 This jumps out to the innermost enclosing `(block NAME ...)' form, 763 This jumps out to the innermost enclosing `(block NAME ...)' form,
761 returning RESULT from that form (or nil if RESULT is omitted). 764 returning RESULT from that form (or nil if RESULT is omitted).
762 This is compatible with Common Lisp, but note that `defun' and 765 This is compatible with Common Lisp, but note that `defun' and
763 `defmacro' do not create implicit blocks as they do in Common Lisp." 766 `defmacro' do not create implicit blocks as they do in Common Lisp."
764 `(throw ',(or (cdr (assq name cl-active-block-names)) (copy-symbol name)) 767 `(throw ',(or (cdr (assq name cl-active-block-names))
765 ,result)) 768 (prog1 (copy-symbol name)
769 (and-fboundp 'byte-compile-warn (cl-compiling-file)
770 (byte-compile-warn
771 "return-from: no enclosing block named `%s'"
772 name))))
773 ,result))
766 774
767 ;;; The "loop" macro. 775 ;;; The "loop" macro.
768 776
769 (defvar args) (defvar loop-accum-var) (defvar loop-accum-vars) 777 (defvar args) (defvar loop-accum-var) (defvar loop-accum-vars)
770 (defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps) 778 (defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps)