(VALBITS, GCTYPEBITS): Deleted; default is better.

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

diff --git a/src/fns.c b/src/fns.c
index 3f67843..e75493d 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -37,7 +37,7 @@ extern Lisp_Object Flookup_key ();
 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
 Lisp_Object Qyes_or_no_p_history;
 
-static Lisp_Object internal_equal ();
+static int internal_equal ();
 \f
 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
   "Return the argument unchanged.")
@@ -101,34 +101,35 @@ A byte-code function object is also allowed.")
   register int i;
 
  retry:
-  if (VECTORP (obj) || STRINGP (obj) || COMPILEDP (obj))
-    return Farray_length (obj);
+  if (STRINGP (obj))
+    XSETFASTINT (val, XSTRING (obj)->size);
+  else if (VECTORP (obj))
+    XSETFASTINT (val, XVECTOR (obj)->size);
+  else if (COMPILEDP (obj))
+    XSETFASTINT (val, XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK);
   else if (CONSP (obj))
     {
-      for (i = 0, tail = obj; !NILP(tail); i++)
+      for (i = 0, tail = obj; !NILP (tail); i++)
        {
          QUIT;
          tail = Fcdr (tail);
        }
 
       XSETFASTINT (val, i);
-      return val;
-    }
-  else if (NILP(obj))
-    {
-      XSETFASTINT (val, 0);
-      return val;
     }
+  else if (NILP (obj))
+    XSETFASTINT (val, 0);
   else
     {
       obj = wrong_type_argument (Qsequencep, obj);
       goto retry;
     }
+  return val;
 }
 
 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
   "T if two strings have identical contents.\n\
-Case is significant.\n\
+Case is significant, but text properties are ignored.\n\
 Symbols are also allowed; their print names are used instead.")
   (s1, s2)
      register Lisp_Object s1, s2;
@@ -243,7 +244,7 @@ Each argument may be a list, vector or string.")
      int nargs;
      Lisp_Object *args;
 {
-  return concat (nargs, args, Lisp_Vector, 0);
+  return concat (nargs, args, Lisp_Vectorlike, 0);
 }
 
 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
@@ -309,7 +310,7 @@ concat (nargs, args, target_type, last_special)
 
   if (target_type == Lisp_Cons)
     val = Fmake_list (len, Qnil);
-  else if (target_type == Lisp_Vector)
+  else if (target_type == Lisp_Vectorlike)
     val = Fmake_vector (len, Qnil);
   else
     val = Fmake_string (len, len);
@@ -868,64 +869,79 @@ Symbols must match exactly.")
   (o1, o2)
      register Lisp_Object o1, o2;
 {
-  return internal_equal (o1, o2, 0);
+  return internal_equal (o1, o2, 0) ? Qt : Qnil;
 }
 
-static Lisp_Object
+static int
 internal_equal (o1, o2, depth)
      register Lisp_Object o1, o2;
      int depth;
 {
   if (depth > 200)
     error ("Stack overflow in equal");
-do_cdr:
+ tail_recurse:
   QUIT;
-  if (EQ (o1, o2)) return Qt;
+  if (EQ (o1, o2)) return 1;
 #ifdef LISP_FLOAT_TYPE
   if (FLOATP (o1) && FLOATP (o2))
-    return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
+    return (extract_float (o1) == extract_float (o2));
 #endif
-  if (XTYPE (o1) != XTYPE (o2)) return Qnil;
-  if (CONSP (o1) || OVERLAYP (o1))
+  if (XTYPE (o1) != XTYPE (o2)) return 0;
+  if (MISCP (o1) && XMISC (o1)->type != XMISC (o2)->type) return 0;
+  if (CONSP (o1))
     {
-      Lisp_Object v1;
-      v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
-      if (NILP (v1))
-       return v1;
-      o1 = Fcdr (o1), o2 = Fcdr (o2);
-      goto do_cdr;
+      if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1))
+       return 0;
+      o1 = XCONS (o1)->cdr;
+      o2 = XCONS (o2)->cdr;
+      goto tail_recurse;
+    }
+  if (OVERLAYP (o1))
+    {
+      if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1), depth + 1)
+         || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o1), depth + 1))
+       return 0;
+      o1 = XOVERLAY (o1)->plist;
+      o2 = XOVERLAY (o2)->plist;
+      goto tail_recurse;
     }
   if (MARKERP (o1))
     {
-      return ((XMARKER (o1)->buffer == XMARKER (o2)->buffer
+      return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
              && (XMARKER (o1)->buffer == 0
-                 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos))
-             ? Qt : Qnil);
+                 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos));
     }
   if (VECTORP (o1) || COMPILEDP (o1))
     {
       register int index;
       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
-       return Qnil;
+       return 0;
       for (index = 0; index < XVECTOR (o1)->size; index++)
        {
-         Lisp_Object v, v1, v2;
+         Lisp_Object v1, v2;
          v1 = XVECTOR (o1)->contents [index];
          v2 = XVECTOR (o2)->contents [index];
-         v = internal_equal (v1, v2, depth + 1);
-         if (NILP (v)) return v;
+         if (!internal_equal (v1, v2, depth + 1))
+           return 0;
        }
-      return Qt;
+      return 1;
     }
   if (STRINGP (o1))
     {
       if (XSTRING (o1)->size != XSTRING (o2)->size)
-       return Qnil;
+       return 0;
       if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
-       return Qnil;
-      return Qt;
+       return 0;
+#ifdef USE_TEXT_PROPERTIES
+      /* If the strings have intervals, verify they match;
+        if not, they are unequal.  */
+      if ((XSTRING (o1)->intervals != 0 || XSTRING (o2)->intervals != 0)
+         && ! compare_string_intervals (o1, o2))
+       return 0;
+#endif
+      return 1;
     }
-  return Qnil;
+  return 0;
 }
 \f
 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
@@ -1195,6 +1211,10 @@ Also accepts Space to mean yes, or Delete to mean no.")
        }
       else if (EQ (def, intern ("quit")))
        Vquit_flag = Qt;
+      /* We want to exit this command for exit-prefix,
+        and this is the only way to do it.  */
+      else if (EQ (def, intern ("exit-prefix")))
+       Vquit_flag = Qt;
 
       QUIT;