--- a/lisp/ChangeLog	Wed Feb 03 20:18:53 2010 +0000
+++ b/lisp/ChangeLog	Wed Feb 03 20:26:47 2010 +0000
@@ -1,3 +1,11 @@
+2010-02-03  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (some, every):
+	Move these functions to C.
+	* cl-macs.el (notany, notevery): Add compiler macros for these
+	functions, no longer proclaim them inline (which would involve
+	specbinding that's not necessary with the compiler macros).
+
 2010-02-03  Aidan Kehoe  <kehoea@parhasard.net>
 
 	Delete a couple of XEmacs-specific functions that duplicate CL

--- a/lisp/cl-extra.el	Wed Feb 03 20:18:53 2010 +0000
+++ b/lisp/cl-extra.el	Wed Feb 03 20:26:47 2010 +0000
@@ -225,34 +225,8 @@
 ;;		      (and (equal "" y) (equal #* x)))))
 ;;		 (t (equal x y)))))))
 
-;; XEmacs; #'map, #'mapc, #'mapl, #'maplist, #'mapcon are now in C, together
-;; with #'map-into, which was never in this file.
-
-(defun some (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of any element of SEQ or SEQs.
-If so, return the true (non-nil) value returned by PREDICATE."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-some
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (let ((cl-res (apply cl-pred cl-x)))
-			     (if cl-res (throw 'cl-some cl-res)))))
-	       cl-seq cl-rest) nil)
-    (let ((cl-x nil))
-      (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
-      cl-x)))
-
-(defun every (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of every element of SEQ or SEQs."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-every
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (or (apply cl-pred cl-x) (throw 'cl-every nil))))
-	       cl-seq cl-rest) t)
-    (while (and cl-seq (funcall cl-pred (car cl-seq)))
-      (setq cl-seq (cdr cl-seq)))
-    (null cl-seq)))
+;; XEmacs; #'map, #'mapc, #'mapl, #'maplist, #'mapcon, #'some and #'every
+;; are now in C, together with #'map-into, which was never in this file.
 
 (defun notany (cl-pred cl-seq &rest cl-rest)
   "Return true if PREDICATE is false of every element of SEQ or SEQs."

--- a/lisp/cl-macs.el	Wed Feb 03 20:18:53 2010 +0000
+++ b/lisp/cl-macs.el	Wed Feb 03 20:26:47 2010 +0000
@@ -3545,6 +3545,12 @@
 ;;	  ;; byte-optimize.el).
 ;;	  (t form)))))
 
+(define-compiler-macro notany (&whole form &rest cl-rest)
+  (cons 'not (cons 'some (cdr cl-rest))))
+
+(define-compiler-macro notevery (&whole form &rest cl-rest)
+  (cons 'not (cons 'every (cdr cl-rest))))
+
 (mapc
  #'(lambda (y)
      (put (car y) 'side-effect-free t)
@@ -3572,7 +3578,7 @@
    (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)))
 
 ;;; Things that are inline.
-(proclaim '(inline acons map concatenate notany notevery
+(proclaim '(inline acons map concatenate
 ;; XEmacs omission: gethash is builtin
 		   cl-set-elt revappend nreconc))
 

--- a/src/ChangeLog	Wed Feb 03 20:18:53 2010 +0000
+++ b/src/ChangeLog	Wed Feb 03 20:26:47 2010 +0000
@@ -1,3 +1,16 @@
+2010-02-03  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (mapcarX):
+	Accept a new argument, indicating whether the function is being
+	called from #'some or #'every. Implement it.
+	Discard any multiple values where that is appropriate.
+	(Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
+	(Fmap_into):
+	Pass the new flag to mapcarX.
+	(Fsome, Fevery): Move these functions here from cl-extra.el;
+	implement them in terms of mapcarX.
+	(maplist): Discard multiple values where appropriate.
+
 2010-02-03  Jerry James  <james@xemacs.org>
 
 	* s/mach-bsd4-3.h: Add historical copyright and license information,

--- a/src/fns.c	Wed Feb 03 20:18:53 2010 +0000
+++ b/src/fns.c	Wed Feb 03 20:26:47 2010 +0000
@@ -3242,11 +3242,24 @@
    non-cons, non-array when traversing SEQUENCES.  Common Lisp specifies in
    MAPPING-DESTRUCTIVE-INTERACTION that it is an error when FUNCTION
    destructively modifies SEQUENCES in a way that might affect the ongoing
-   traversal operation. */
+   traversal operation.
+
+   If SOME_OR_EVERY is SOME_OR_EVERY_SOME, return the (possibly multiple)
+   values given by FUNCTION the first time it is non-nil, and abandon the
+   iterations.  LISP_VALS in this case must be an object created by
+   make_opaque_ptr, dereferenced as pointing to a Lisp object. If
+   SOME_OR_EVERY is SOME_OR_EVERY_EVERY, store Qnil at the Lisp_Object
+   pointer address provided by LISP_VALS if FUNCTION gives nil; otherwise
+   leave it alone. */
+
+#define SOME_OR_EVERY_NEITHER 0
+#define SOME_OR_EVERY_SOME    1
+#define SOME_OR_EVERY_EVERY   2
 
 static void
 mapcarX (Elemcount call_count, Lisp_Object *vals, Lisp_Object lisp_vals,
-	 Lisp_Object function, int nsequences, Lisp_Object *sequences)
+	 Lisp_Object function, int nsequences, Lisp_Object *sequences, 
+	 int some_or_every)
 {
   Lisp_Object called, *args;
   struct gcpro gcpro1, gcpro2;
@@ -3350,7 +3363,7 @@
 	  called = Ffuncall (nsequences + 1, args);
 	  if (vals != NULL)
 	    {
-	      vals[i] = called;
+	      vals[i] = IGNORE_MULTIPLE_VALUES (called);
 	      gcpro2.nvars += 1;
 	    }
 	  else
@@ -3361,20 +3374,50 @@
 		  break;
 		case lrecord_type_cons:
 		  {
-		    if (!CONSP (lisp_vals))
+		    if (SOME_OR_EVERY_NEITHER == some_or_every)
+		      {
+			called = IGNORE_MULTIPLE_VALUES (called);
+			if (!CONSP (lisp_vals))
+			  {
+			    /* If FUNCTION has inserted a non-cons non-nil
+			       cdr into the list before we've processed the
+			       relevant part, error. */
+			    dead_wrong_type_argument (Qconsp, lisp_vals);
+			  }
+
+			XSETCAR (lisp_vals, called);
+			lisp_vals = XCDR (lisp_vals);
+			break;
+		      }
+
+		    if (SOME_OR_EVERY_SOME == some_or_every)
 		      {
-			/* If FUNCTION has inserted a non-cons non-nil cdr
-			   into the list before we've processed the relevant
-			   part, error. */
-			dead_wrong_type_argument (Qconsp, lisp_vals);
+			if (!NILP (IGNORE_MULTIPLE_VALUES (called)))
+			  {
+			    XCAR (lisp_vals) = called;
+			    UNGCPRO;
+			    return;
+			  }
+			break;
 		      }
 
-		    XSETCAR (lisp_vals, called);
-		    lisp_vals = XCDR (lisp_vals);
-		    break;
+		    if (SOME_OR_EVERY_EVERY == some_or_every)
+		      {
+			called = IGNORE_MULTIPLE_VALUES (called);
+			if (NILP (called))
+			  {
+			    XCAR (lisp_vals) = Qnil;
+			    UNGCPRO;
+			    return;
+			  }
+			break;
+		      }
+
+		    goto bad_show_or_every_flag;
 		  }
 		case lrecord_type_vector:
 		  {
+		    called = IGNORE_MULTIPLE_VALUES (called);
 		    i < XVECTOR_LENGTH (lisp_vals) ?
 		      (XVECTOR_DATA (lisp_vals)[i] = called) :
 		      /* Let #'aset error. */
@@ -3386,11 +3429,13 @@
 		    /* If this ever becomes a code hotspot, we can keep
 		       around pointers into the data of the string, checking
 		       each time that it hasn't been relocated. */
+		    called = IGNORE_MULTIPLE_VALUES (called);
 		    Faset (lisp_vals, make_int (i), called);
 		    break;
 		  }
 		case lrecord_type_bit_vector:
 		  {
+		    called = IGNORE_MULTIPLE_VALUES (called);
 		    (BITP (called) &&
 		     i < bit_vector_length (XBIT_VECTOR (lisp_vals))) ?
 		      set_bit_vector_bit (XBIT_VECTOR (lisp_vals), i,
@@ -3398,6 +3443,7 @@
 		      Faset (lisp_vals, make_int (i), called);
 		    break;
 		  }
+		bad_show_or_every_flag:
 		default:
 		  {
 		    ABORT();
@@ -3461,7 +3507,8 @@
     }
   else
     {
-      mapcarX (len, args0, Qnil, function, nargs - 2, args + 2);
+      mapcarX (len, args0, Qnil, function, nargs - 2, args + 2,
+	       SOME_OR_EVERY_NEITHER);
     }
 
   for (i = len - 1; i >= 0; i--)
@@ -3499,7 +3546,8 @@
     }
 
   args0 = alloca_array (Lisp_Object, len);
-  mapcarX (len, args0, Qnil, function, nargs - 1, args + 1);
+  mapcarX (len, args0, Qnil, function, nargs - 1, args + 1,
+	   SOME_OR_EVERY_NEITHER);
 
   return Flist ((int) len, args0);
 }
@@ -3534,7 +3582,8 @@
   GCPRO1 (result);
   /* Don't pass result as the lisp_object argument, we want mapcarX to protect 
      a single list argument's elements from being garbage-collected. */
-  mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1);
+  mapcarX (len, XVECTOR_DATA (result), Qnil, function, nargs - 1, args +1,
+	   SOME_OR_EVERY_NEITHER);
   UNGCPRO;
 
   return result;
@@ -3568,7 +3617,8 @@
     }
 
   args0 = alloca_array (Lisp_Object, len + 1);
-  mapcarX (len, args0 + 1, Qnil, function, nargs - 1, args + 1);
+  mapcarX (len, args0 + 1, Qnil, function, nargs - 1, args + 1,
+	   SOME_OR_EVERY_NEITHER);
 
   if (len < 2)
     {
@@ -3623,7 +3673,8 @@
      elements of the args array handed to it, and this may involve
      elements of sequence getting garbage collected. */
   GCPRO1 (sequence);
-  mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1);
+  mapcarX (len, NULL, Qnil, args[0], nargs - 1, args + 1,
+	   SOME_OR_EVERY_NEITHER);
   RETURN_UNGCPRO (sequence);
 }
 
@@ -3663,7 +3714,8 @@
       args0 = alloca_array (Lisp_Object, len);
     }
 
-  mapcarX (len, args0, Qnil, function, nargs - 2, args + 2);
+  mapcarX (len, args0, Qnil, function, nargs - 2, args + 2,
+	   SOME_OR_EVERY_NEITHER);
 
   if (EQ (type, Qnil))
     {
@@ -3727,10 +3779,73 @@
       len = min (len, XINT (Flength (args[i])));
     }
 
-  mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2);
+  mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
+	   SOME_OR_EVERY_NEITHER);
 
   return result_sequence;
 }
+
+DEFUN ("some", Fsome, 2, MANY, 0, /* 
+Return true if PREDICATE gives non-nil for an element of SEQUENCE.
+
+If so, return the value (possibly multiple) given by PREDICATE.
+
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  Lisp_Object result_box = Fcons (Qnil, Qnil);
+  struct gcpro gcpro1;
+  Elemcount len = EMACS_INT_MAX;
+  int i;
+
+  GCPRO1 (result_box);
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1,
+	   SOME_OR_EVERY_SOME);
+
+  RETURN_UNGCPRO (XCAR (result_box));
+}
+
+DEFUN ("every", Fevery, 2, MANY, 0, /* 
+Return true if PREDICATE is true of every element of SEQUENCE.
+
+With optional SEQUENCES, call PREDICATE each time with as many arguments as
+there are SEQUENCES (plus one for the element from SEQUENCE).
+
+In contrast to `some', `every' never returns multiple values.
+
+arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
+*/
+       (int nargs, Lisp_Object *args))
+{
+  Lisp_Object result_box = Fcons (Qt, Qnil);
+  struct gcpro gcpro1;
+  Elemcount len = EMACS_INT_MAX;
+  int i;
+
+  GCPRO1 (result_box);
+
+  for (i = 1; i < nargs; ++i)
+    {
+      CHECK_SEQUENCE (args[i]);
+      len = min (len, XINT (Flength (args[i])));
+    }
+
+  mapcarX (len, NULL, result_box, args[0], nargs - 1, args +1,
+	   SOME_OR_EVERY_EVERY);
+
+  RETURN_UNGCPRO (XCAR (result_box));
+}
 
 /* Call FUNCTION with NLISTS arguments repeatedly, each Nth argument
    corresponding to the result of calling (nthcdr ITERATION-COUNT LISTS[N]),
@@ -3793,7 +3908,7 @@
 	    }
 	}
       if (!continuing) break;
-      funcalled = Ffuncall (nlists + 1, args);
+      funcalled = IGNORE_MULTIPLE_VALUES (Ffuncall (nlists + 1, args));
       if (!maplp)
 	{
 	  if (nconcp)
@@ -4639,6 +4754,8 @@
   DEFSUBR (Fmapconcat);
   DEFSUBR (Fmap);
   DEFSUBR (Fmap_into);
+  DEFSUBR (Fsome);
+  DEFSUBR (Fevery);
   Ffset (intern ("mapc-internal"), Fsymbol_function (intern ("mapc")));
   Ffset (intern ("mapcar"), Fsymbol_function (intern ("mapcar*")));
   DEFSUBR (Fmaplist);