* fns.c (Fmaphash): Say what `maphash' returns, since it may be unintuitive.

[bpt/emacs.git] / src / fns.c

diff --git a/src/fns.c b/src/fns.c
index 93829fb..eb69ce1 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,6 +1,7 @@
 /* Random utility Lisp functions.
 
-Copyright (C) 1985-1987, 1993-1995, 1997-2013 Free Software Foundation, Inc.
+Copyright (C) 1985-1987, 1993-1995, 1997-2014 Free Software Foundation,
+Inc.
 
 This file is part of GNU Emacs.
 
@@ -35,11 +36,9 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "frame.h"
 #include "window.h"
 #include "blockinput.h"
-#ifdef HAVE_MENUS
 #if defined (HAVE_X_WINDOWS)
 #include "xterm.h"
 #endif
-#endif /* HAVE_MENUS */
 
 Lisp_Object Qstring_lessp;
 static Lisp_Object Qprovide, Qrequire;
@@ -50,7 +49,7 @@ static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
 
 static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
 
-static bool internal_equal (Lisp_Object, Lisp_Object, int, bool);
+static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object);
 \f
 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
        doc: /* Return the argument unchanged.  */)
@@ -1357,7 +1356,7 @@ The value is actually the tail of LIST whose car is ELT.  */)
       register Lisp_Object tem;
       CHECK_LIST_CONS (tail, list);
       tem = XCAR (tail);
-      if (FLOATP (tem) && internal_equal (elt, tem, 0, 0))
+      if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
        return tail;
       QUIT;
     }
@@ -1539,15 +1538,12 @@ Write `(setq foo (delq element foo))' to be sure of correctly changing
 the value of a list `foo'.  */)
   (register Lisp_Object elt, Lisp_Object list)
 {
-  register Lisp_Object tail, prev;
-  register Lisp_Object tem;
+  Lisp_Object tail, tortoise, prev = Qnil;
+  bool skip;
 
-  tail = list;
-  prev = Qnil;
-  while (CONSP (tail))
+  FOR_EACH_TAIL (tail, list, tortoise, skip)
     {
-      CHECK_LIST_CONS (tail, list);
-      tem = XCAR (tail);
+      Lisp_Object tem = XCAR (tail);
       if (EQ (elt, tem))
        {
          if (NILP (prev))
@@ -1557,8 +1553,6 @@ the value of a list `foo'.  */)
        }
       else
        prev = tail;
-      tail = XCDR (tail);
-      QUIT;
     }
   return list;
 }
@@ -1961,7 +1955,7 @@ Floating-point numbers of equal value are `eql', but they may not be `eq'.  */)
   (Lisp_Object obj1, Lisp_Object obj2)
 {
   if (FLOATP (obj1))
-    return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil;
+    return internal_equal (obj1, obj2, 0, 0, Qnil) ? Qt : Qnil;
   else
     return EQ (obj1, obj2) ? Qt : Qnil;
 }
@@ -1976,7 +1970,7 @@ Numbers are compared by value, but integers cannot equal floats.
 Symbols must match exactly.  */)
   (register Lisp_Object o1, Lisp_Object o2)
 {
-  return internal_equal (o1, o2, 0, 0) ? Qt : Qnil;
+  return internal_equal (o1, o2, 0, 0, Qnil) ? Qt : Qnil;
 }
 
 DEFUN ("equal-including-properties", Fequal_including_properties, Sequal_including_properties, 2, 2, 0,
@@ -1985,7 +1979,7 @@ This is like `equal' except that it compares the text properties
 of strings.  (`equal' ignores text properties.)  */)
   (register Lisp_Object o1, Lisp_Object o2)
 {
-  return internal_equal (o1, o2, 0, 1) ? Qt : Qnil;
+  return internal_equal (o1, o2, 0, 1, Qnil) ? Qt : Qnil;
 }
 
 /* DEPTH is current depth of recursion.  Signal an error if it
@@ -1993,10 +1987,41 @@ of strings.  (`equal' ignores text properties.)  */)
    PROPS means compare string text properties too.  */
 
 static bool
-internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
+internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
+               Lisp_Object ht)
 {
-  if (depth > 200)
-    error ("Stack overflow in equal");
+  if (depth > 10)
+    {
+      if (depth > 200)
+       error ("Stack overflow in equal");
+      if (NILP (ht))
+       {
+         Lisp_Object args[2];
+         args[0] = QCtest;
+         args[1] = Qeq;
+         ht = Fmake_hash_table (2, args);
+       }
+      switch (XTYPE (o1))
+       {
+       case Lisp_Cons: case Lisp_Misc: case Lisp_Vectorlike:
+         {
+           struct Lisp_Hash_Table *h = XHASH_TABLE (ht);
+           EMACS_UINT hash;
+           ptrdiff_t i = hash_lookup (h, o1, &hash);
+           if (i >= 0)
+             { /* `o1' was seen already.  */
+               Lisp_Object o2s = HASH_VALUE (h, i);
+               if (!NILP (Fmemq (o2, o2s)))
+                 return 1;
+               else
+                 set_hash_value_slot (h, i, Fcons (o2, o2s));
+             }
+           else
+             hash_put (h, o1, Fcons (o2, Qnil), hash);
+         }
+       default: ;
+       }
+    }
 
  tail_recurse:
   QUIT;
@@ -2019,10 +2044,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
       }
 
     case Lisp_Cons:
-      if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props))
+      if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht))
        return 0;
       o1 = XCDR (o1);
       o2 = XCDR (o2);
+      /* FIXME: This inf-loops in a circular list!  */
       goto tail_recurse;
 
     case Lisp_Misc:
@@ -2031,9 +2057,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
       if (OVERLAYP (o1))
        {
          if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
-                              depth + 1, props)
+                              depth + 1, props, ht)
              || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
-                                 depth + 1, props))
+                                 depth + 1, props, ht))
            return 0;
          o1 = XOVERLAY (o1)->plist;
          o2 = XOVERLAY (o2)->plist;
@@ -2085,7 +2111,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
            Lisp_Object v1, v2;
            v1 = AREF (o1, i);
            v2 = AREF (o2, i);
-           if (!internal_equal (v1, v2, depth + 1, props))
+           if (!internal_equal (v1, v2, depth + 1, props, ht))
              return 0;
          }
        return 1;
@@ -2416,7 +2442,6 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil.  */)
 
   CHECK_STRING (prompt);
 
-#ifdef HAVE_MENUS
   if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
       && use_dialog_box)
     {
@@ -2430,7 +2455,6 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil.  */)
       UNGCPRO;
       return obj;
     }
-#endif /* HAVE_MENUS */
 
   args[0] = prompt;
   args[1] = build_string ("(yes or no) ");
@@ -4484,7 +4508,8 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
 
 DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
        doc: /* Call FUNCTION for all entries in hash table TABLE.
-FUNCTION is called with two arguments, KEY and VALUE.  */)
+FUNCTION is called with two arguments, KEY and VALUE.
+`maphash' always returns nil.  */)
   (Lisp_Object function, Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);