diff lisp/cl-macs.el @ 5474:4dee0387b9de

Merged with trunk.
author Mats Lidell <matsl@xemacs.org>
date Tue, 29 Mar 2011 00:02:47 +0200
parents ac37a5f7e5be 3889ef128488
children 248176c74e6b
line wrap: on
line diff
--- a/lisp/cl-macs.el	Thu Mar 17 23:42:59 2011 +0100
+++ b/lisp/cl-macs.el	Tue Mar 29 00:02:47 2011 +0200
@@ -765,12 +765,12 @@
 This is compatible with Common Lisp, but note that `defun' and
 `defmacro' do not create implicit blocks as they do in Common Lisp."
   `(throw ',(or (cdr (assq name cl-active-block-names))
-		(prog1 (copy-symbol name)
-		  (and-fboundp 'byte-compile-warn (cl-compiling-file)
-			       (byte-compile-warn
-				"return-from: no enclosing block named `%s'"
-				name))))
-	 ,result))
+                ;; Tell the byte-compiler the original name of the block,
+                ;; leave any warning to it.
+                (let ((copy-symbol (copy-symbol name)))
+                  (put copy-symbol 'cl-block-name name)
+                  copy-symbol))
+           ,result))
 
 ;;; The "loop" macro.
 
@@ -826,7 +826,7 @@
 `return-from'.)
 
 Another extremely useful feature of loops is called \"destructuring\".  If,
-in place of VAR, a list (possibly dotted, possibly a tree of arbitary
+in place of VAR, a list (possibly dotted, possibly a tree of arbitrary
 complexity) is given, the value to be assigned is assumed to have a similar
 structure to the list given, and variables in the list will be matched up
 with corresponding elements in the structure.  For example:
@@ -3228,14 +3228,26 @@
 			argns argvs)))
       (if lets (list 'let lets body) body))))
 
+;; When a 64-bit build is byte-compiling code, some of its native fixnums
+;; will not be represented as fixnums if the byte-compiled code is read by
+;; the Lisp reader in a 32-bit build. So in that case we need to check the
+;; range of fixnums as well as their types. XEmacs doesn't support machines
+;; with word size less than 32, so it's OK to have that as the minimum.
+(macrolet
+    ((most-negative-fixnum-on-32-bit-machines () (lognot (1- (lsh 1 30))))
+     (most-positive-fixnum-on-32-bit-machines () (lsh 1 30)))
+  (defun cl-non-fixnum-number-p (object)
+    "Return t if OBJECT is a number not guaranteed to be immediate."
+    (and (numberp object)
+	 (or (not (fixnump object))
+	     (not (<= (most-negative-fixnum-on-32-bit-machines)
+		      object
+		      (most-positive-fixnum-on-32-bit-machines)))))))
 
 ;;; Compile-time optimizations for some functions defined in this package.
 ;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
 ;;; mainly to make sure these macros will be present.
 
-(defun cl-non-fixnum-number-p (object)
-  (and (numberp object) (not (fixnump object))))
-
 (define-compiler-macro eql (&whole form a b)
   (cond ((eq (cl-const-expr-p a) t)
 	 (let ((val (cl-const-expr-val a)))
@@ -3696,6 +3708,12 @@
 (define-compiler-macro pairlis (a b &optional c)
   `(nconc (mapcar* #'cons ,a ,b) ,c))
 
+(define-compiler-macro revappend (&whole form &rest args)
+  (if (eql 3 (length form)) `(nconc (reverse ,(pop args)) ,(pop args)) form))
+
+(define-compiler-macro nreconc (&whole form &rest args)
+  (if (eql 3 (length form)) `(nconc (nreverse ,(pop args)) ,(pop args)) form))
+
 (define-compiler-macro complement (&whole form fn)
   (if (or (eq (car-safe fn) 'function) (eq (car-safe fn) 'quote))
       (cond