diff lisp/bytecomp.el @ 5470:0af042a0c116

Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Mon, 07 Feb 2011 21:22:17 +0100
parents 002cb5224e4f 38e24b8be4ea
children 00e79bbbe48f
line wrap: on
line diff
--- a/lisp/bytecomp.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/bytecomp.el	Mon Feb 07 21:22:17 2011 +0100
@@ -509,7 +509,11 @@
 		    "%s is not of type %s" form type)))
 	   (if byte-compile-delete-errors
 	       form
-	     (funcall (cdr (symbol-function 'the)) type form)))))
+	     (funcall (cdr (symbol-function 'the)) type form))))
+    (return-from .
+      ,#'(lambda (name &optional result) `(return-from-1 ',name ,result)))
+    (block .
+      ,#'(lambda (name &rest body) `(block-1 ',name ,@body))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -3727,13 +3731,10 @@
 	    ;; Odd number of args?  Let `set' get the error.
 	    (byte-compile-form `(set ',var) for-effect)
 	  (setq val (pop args))
-	  (if (keywordp var)
-	      ;; (setq :foo ':foo) compatibility kludge
-	      (byte-compile-form `(set ',var ,val) (if args t for-effect))
-	    (byte-compile-form val)
-	    (unless (or args for-effect)
-	      (byte-compile-out 'byte-dup 0))
-	    (byte-compile-variable-ref 'byte-varset var))))))
+          (byte-compile-form val)
+          (unless (or args for-effect)
+            (byte-compile-out 'byte-dup 0))
+          (byte-compile-variable-ref 'byte-varset var)))))
   (setq for-effect nil))
 
 (defun byte-compile-set (form)
@@ -3743,11 +3744,10 @@
   (let ((symform (nth 1 form))
 	(valform (nth 2 form))
 	sym)
-    (if (and (= (length form) 3)
-	     (= (safe-length symform) 2)
+    (if (and (eql (length form) 3)
+	     (eql (safe-length symform) 2)
 	     (eq (car symform) 'quote)
-	     (symbolp (setq sym (car (cdr symform))))
-	     (not (byte-compile-constant-symbol-p sym)))
+	     (symbolp (setq sym (car (cdr symform)))))
 	(byte-compile-setq `(setq ,sym ,valform))
       (byte-compile-two-args form))))
 
@@ -4184,6 +4184,8 @@
 ;;; other tricky macro-like special-operators
 
 (byte-defop-compiler-1 catch)
+(byte-defop-compiler-1 block-1)
+(byte-defop-compiler-1 return-from-1)
 (byte-defop-compiler-1 unwind-protect)
 (byte-defop-compiler-1 condition-case)
 (byte-defop-compiler-1 save-excursion)
@@ -4198,6 +4200,39 @@
     (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
   (byte-compile-out 'byte-catch 0))
 
+;; `return-from' and `block' are different from `throw' and `catch' when it
+;; comes to scope and extent. These differences are implemented for
+;; interpreted code in cl-macs.el, in compiled code in bytecomp.el. There's
+;; a certain amount of bootstrapping needed for the latter, and until this
+;; is done return-from and block behave as throw and catch in their scope
+;; and extent. This is only relevant to people working on bytecomp.el.
+
+(defalias 'return-from-1 'throw)
+(defalias 'block-1 'catch)
+
+(defvar byte-compile-active-blocks nil)
+
+(defun byte-compile-block-1 (form)
+  (let* ((name (nth 1 (nth 1 form)))
+	 (elt (list name (copy-symbol name) nil))
+	 (byte-compile-active-blocks (cons elt byte-compile-active-blocks))
+	 (body (byte-compile-top-level (cons 'progn (cddr form)))))
+    (if (nth 2 elt)
+	(byte-compile-catch `(catch ',(nth 1 elt) ,body))
+      (byte-compile-form body))))
+
+(defun byte-compile-return-from-1 (form)
+  (let* ((name (nth 1 (nth 1 form)))
+	 (assq (assq name byte-compile-active-blocks)))
+    (if assq
+	(setf (nth 2 assq) t)
+      (byte-compile-warn
+       "return-from: %S: no current lexical block with this name"
+       name))
+    (byte-compile-throw
+     `(throw ',(or (nth 1 assq) (copy-symbol name))
+             ,@(nthcdr 2 form)))))
+
 (defun byte-compile-unwind-protect (form)
   (byte-compile-push-constant
    (byte-compile-top-level-body (cdr (cdr form)) t))