xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 5473:ac37a5f7e5be

Merge with trunk.

author	Mats Lidell <matsl@xemacs.org>
date	Thu, 17 Mar 2011 23:42:59 +0100
parents	e79980ee5efe d967d96ca043
children	248176c74e6b

comparison

equal deleted inserted replaced

-:e79980ee5efe
+:ac37a5f7e5be
 Lisp_Object Vpath_separator;
 extern Fixnum max_lisp_eval_depth;
 extern int lisp_eval_depth;
-static int internal_old_equal (Lisp_Object, Lisp_Object, int);
 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
 static DOESNT_RETURN
 mapping_interaction_error (Lisp_Object func, Lisp_Object object)
 {
 {
 Charcount ccstart, ccend;
 Bytecount bstart, blen;
 Lisp_Object val;
+CHECK_STRING (string);
 get_string_range_char (string, start, end, &ccstart, &ccend,
 GB_HISTORICAL_STRING_BEHAVIOR);
 bstart = string_index_char_to_byte (string, ccstart);
 blen = string_offset_char_to_byte_len (string, bstart, ccend - ccstart);
 val = make_string (XSTRING_DATA (string) + bstart, blen);
 return tail;
 }
 return Qnil;
 }
-DEFUN ("old-member", Fold_member, 2, 2, 0, /*
-Return non-nil if ELT is an element of LIST.  Comparison done with `old-equal'.
-The value is actually the tail of LIST whose car is ELT.
-This function is provided only for byte-code compatibility with v19.
-Do not use it.
-*/
-(elt, list))
-{
-EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
-{
-if (internal_old_equal (elt, list_elt, 0))
-return tail;
-}
-return Qnil;
-}
 DEFUN ("memq", Fmemq, 2, 2, 0, /*
 Return non-nil if ELT is an element of LIST.  Comparison done with `eq'.
 The value is actually the tail of LIST whose car is ELT.
 */
 (elt, list))
 {
 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
 {
 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
-return tail;
-}
-return Qnil;
-}
-DEFUN ("old-memq", Fold_memq, 2, 2, 0, /*
-Return non-nil if ELT is an element of LIST.  Comparison done with `old-eq'.
-The value is actually the tail of LIST whose car is ELT.
-This function is provided only for byte-code compatibility with v19.
-Do not use it.
-*/
-(elt, list))
-{
-EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
-{
-if (HACKEQ_UNSAFE (elt, list_elt))
 return tail;
 }
 return Qnil;
 }
 	return elt;
 }
 return Qnil;
 }
-DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
-Return non-nil if KEY is `old-equal' to the car of an element of ALIST.
-The value is actually the element of ALIST whose car equals KEY.
-*/
-(key, alist))
-{
-/* This function can GC. */
-EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
-{
-if (internal_old_equal (key, elt_car, 0))
-	return elt;
-}
-return Qnil;
-}
 Lisp_Object
 assoc_no_quit (Lisp_Object key, Lisp_Object alist)
 {
 int speccount = specpdl_depth ();
 specbind (Qinhibit_quit, Qt);
 (key, alist))
 {
 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
 {
 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
-	return elt;
-}
-return Qnil;
-}
-DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
-Return non-nil if KEY is `old-eq' to the car of an element of ALIST.
-The value is actually the element of ALIST whose car is KEY.
-Elements of ALIST that are not conses are ignored.
-This function is provided only for byte-code compatibility with v19.
-Do not use it.
-*/
-(key, alist))
-{
-EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
-{
-if (HACKEQ_UNSAFE (key, elt_car))
 	return elt;
 }
 return Qnil;
 }
 (value, alist))
 {
 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
 {
 if (internal_equal (value, elt_cdr, 0))
-	return elt;
-}
-return Qnil;
-}
-DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
-Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST.
-The value is actually the element of ALIST whose cdr equals VALUE.
-*/
-(value, alist))
-{
-EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
-{
-if (internal_old_equal (value, elt_cdr, 0))
 	return elt;
 }
 return Qnil;
 }
 test, key, start, end, from_end, default_, Qposition);
 return object;
 }
-DEFUN ("old-delete", Fold_delete, 2, 2, 0, /*
-Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned.  Comparison is done with `old-equal'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (old-delete element foo))' to be sure
-of changing the value of `foo'.
-*/
-(elt, list))
-{
-EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
-				(internal_old_equal (elt, list_elt, 0)));
-return list;
-}
-DEFUN ("old-delq", Fold_delq, 2, 2, 0, /*
-Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned.  Comparison is done with `old-eq'.
-If the first member of LIST is ELT, there is no way to remove it by side
-effect; therefore, write `(setq foo (old-delq element foo))' to be sure of
-changing the value of `foo'.
-*/
-(elt, list))
-{
-EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
-				(HACKEQ_UNSAFE (elt, list_elt)));
-return list;
-}
 /* Like Fdelq, but caller must ensure that LIST is properly
 nil-terminated and ebola-free. */
 Lisp_Object
 delq_no_quit (Lisp_Object elt, Lisp_Object list)
 return internal_equalp (obj1, obj2, depth);
 else
 return internal_equal (obj1, obj2, depth);
 }
+DEFUN ("equal", Fequal, 2, 2, 0, /*
+Return t if two Lisp objects have similar structure and contents.
+They must have the same data type.
+Conses are compared by comparing the cars and the cdrs.
+Vectors and strings are compared element by element.
+Numbers are compared by value.  Symbols must match exactly.
+*/
+(object1, object2))
+{
+return internal_equal (object1, object2, 0) ? Qt : Qnil;
+}
+DEFUN ("equalp", Fequalp, 2, 2, 0, /*
+Return t if two Lisp objects have similar structure and contents.
+This is like `equal', except that it accepts numerically equal
+numbers of different types (float, integer, bignum, bigfloat), and also
+compares strings and characters case-insensitively.
+Type objects that are arrays (that is, strings, bit-vectors, and vectors)
+of the same length and with contents that are `equalp' are themselves
+`equalp', regardless of whether the two objects have the same type.
+Other objects whose primary purpose is as containers of other objects are
+`equalp' if they would otherwise be equal (same length, type, etc.) and
+their contents are `equalp'.  This goes for conses, weak lists,
+weak boxes, ephemerons, specifiers, hash tables, char tables and range
+tables.  However, objects that happen to contain other objects but are not
+primarily designed for this purpose (e.g. compiled functions, events or
+display-related objects such as glyphs, faces or extents) are currently
+compared using `equalp' the same way as using `equal'.
+More specifically, two hash tables are `equalp' if they have the same test
+(see `hash-table-test'), the same number of entries, and the same value for
+`hash-table-weakness', and if, for each entry in one hash table, its key is
+equivalent to a key in the other hash table using the hash table test, and
+its value is `equalp' to the other hash table's value for that key.
+*/
+(object1, object2))
+{
+return internal_equalp (object1, object2, 0) ? Qt : Qnil;
+}
+#ifdef SUPPORT_CONFOUNDING_FUNCTIONS
 /* Note that we may be calling sub-objects that will use
 internal_equal() (instead of internal_old_equal()).  Oh well.
 We will get an Ebola note if there's any possibility of confusion,
 but that seems unlikely. */
 return 0;
 return internal_equal (obj1, obj2, depth);
 }
-DEFUN ("equal", Fequal, 2, 2, 0, /*
+DEFUN ("old-member", Fold_member, 2, 2, 0, /*
-Return t if two Lisp objects have similar structure and contents.
+Return non-nil if ELT is an element of LIST.  Comparison done with `old-equal'.
-They must have the same data type.
+The value is actually the tail of LIST whose car is ELT.
-Conses are compared by comparing the cars and the cdrs.
+This function is provided only for byte-code compatibility with v19.
-Vectors and strings are compared element by element.
+Do not use it.
-Numbers are compared by value.  Symbols must match exactly.
+*/
-*/
+(elt, list))
-(object1, object2))
+{
-{
+EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
-return internal_equal (object1, object2, 0) ? Qt : Qnil;
+{
-}
+if (internal_old_equal (elt, list_elt, 0))
+return tail;
-DEFUN ("equalp", Fequalp, 2, 2, 0, /*
+}
-Return t if two Lisp objects have similar structure and contents.
+return Qnil;
+}
-This is like `equal', except that it accepts numerically equal
-numbers of different types (float, integer, bignum, bigfloat), and also
+DEFUN ("old-memq", Fold_memq, 2, 2, 0, /*
-compares strings and characters case-insensitively.
+Return non-nil if ELT is an element of LIST.  Comparison done with `old-eq'.
+The value is actually the tail of LIST whose car is ELT.
-Type objects that are arrays (that is, strings, bit-vectors, and vectors)
+This function is provided only for byte-code compatibility with v19.
-of the same length and with contents that are `equalp' are themselves
+Do not use it.
-`equalp', regardless of whether the two objects have the same type.
+*/
+(elt, list))
-Other objects whose primary purpose is as containers of other objects are
+{
-`equalp' if they would otherwise be equal (same length, type, etc.) and
+EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
-their contents are `equalp'.  This goes for conses, weak lists,
+{
-weak boxes, ephemerons, specifiers, hash tables, char tables and range
+if (HACKEQ_UNSAFE (elt, list_elt))
-tables.  However, objects that happen to contain other objects but are not
+return tail;
-primarily designed for this purpose (e.g. compiled functions, events or
+}
-display-related objects such as glyphs, faces or extents) are currently
+return Qnil;
-compared using `equalp' the same way as using `equal'.
+}
-More specifically, two hash tables are `equalp' if they have the same test
+DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /*
-(see `hash-table-test'), the same number of entries, and the same value for
+Return non-nil if KEY is `old-equal' to the car of an element of ALIST.
-`hash-table-weakness', and if, for each entry in one hash table, its key is
+The value is actually the element of ALIST whose car equals KEY.
-equivalent to a key in the other hash table using the hash table test, and
+*/
-its value is `equalp' to the other hash table's value for that key.
+(key, alist))
-*/
+{
-(object1, object2))
+/* This function can GC. */
-{
+EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
-return internal_equalp (object1, object2, 0) ? Qt : Qnil;
+{
+if (internal_old_equal (key, elt_car, 0))
+	return elt;
+}
+return Qnil;
+}
+DEFUN ("old-assq", Fold_assq, 2, 2, 0, /*
+Return non-nil if KEY is `old-eq' to the car of an element of ALIST.
+The value is actually the element of ALIST whose car is KEY.
+Elements of ALIST that are not conses are ignored.
+This function is provided only for byte-code compatibility with v19.
+Do not use it.
+*/
+(key, alist))
+{
+EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
+{
+if (HACKEQ_UNSAFE (key, elt_car))
+	return elt;
+}
+return Qnil;
+}
+DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /*
+Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST.
+The value is actually the element of ALIST whose cdr equals VALUE.
+*/
+(value, alist))
+{
+EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
+{
+if (internal_old_equal (value, elt_cdr, 0))
+	return elt;
+}
+return Qnil;
+}
+DEFUN ("old-delete", Fold_delete, 2, 2, 0, /*
+Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned.  Comparison is done with `old-equal'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (old-delete element foo))' to be sure
+of changing the value of `foo'.
+*/
+(elt, list))
+{
+EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
+				(internal_old_equal (elt, list_elt, 0)));
+return list;
+}
+DEFUN ("old-delq", Fold_delq, 2, 2, 0, /*
+Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned.  Comparison is done with `old-eq'.
+If the first member of LIST is ELT, there is no way to remove it by side
+effect; therefore, write `(setq foo (old-delq element foo))' to be sure of
+changing the value of `foo'.
+*/
+(elt, list))
+{
+EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
+				(HACKEQ_UNSAFE (elt, list_elt)));
+return list;
 }
 DEFUN ("old-equal", Fold_equal, 2, 2, 0, /*
 Return t if two Lisp objects have similar structure and contents.
 They must have the same data type.
 */
 (object1, object2))
 {
 return internal_old_equal (object1, object2, 0) ? Qt : Qnil;
 }
+DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
+Return t if the two args are (in most cases) the same Lisp object.
+Special kludge: A character is considered `old-eq' to its equivalent integer
+even though they are not the same object and are in fact of different
+types.  This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
+preserve byte-code compatibility with v19.  This kludge is known as the
+\"char-int confoundance disease\" and appears in a number of other
+functions with `old-foo' equivalents.
+Do not use this function!
+*/
+(object1, object2))
+{
+/* #### blasphemy */
+return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil;
+}
+#endif
 static Lisp_Object replace_string_range_1 (Lisp_Object dest,
 					   Lisp_Object start,
 					   Lisp_Object end,
 DEFSUBR (Felt);
 DEFSUBR (Flast);
 DEFSUBR (Fbutlast);
 DEFSUBR (Fnbutlast);
 DEFSUBR (Fmember);
-DEFSUBR (Fold_member);
 DEFSUBR (Fmemq);
-DEFSUBR (Fold_memq);
 DEFSUBR (FmemberX);
 DEFSUBR (Fadjoin);
 DEFSUBR (Fassoc);
-DEFSUBR (Fold_assoc);
 DEFSUBR (Fassq);
-DEFSUBR (Fold_assq);
 DEFSUBR (Frassoc);
-DEFSUBR (Fold_rassoc);
 DEFSUBR (Frassq);
-DEFSUBR (Fold_rassq);
 DEFSUBR (Fposition);
 DEFSUBR (Ffind);
-DEFSUBR (Fold_delete);
-DEFSUBR (Fold_delq);
 DEFSUBR (FdeleteX);
 DEFSUBR (FremoveX);
 DEFSUBR (Fremassoc);
 DEFSUBR (Fremassq);
 DEFSUBR (Fremrassoc);
 DEFSUBR (Fremprop);
 DEFSUBR (Fobject_plist);
 DEFSUBR (Fobject_setplist);
 DEFSUBR (Fequal);
 DEFSUBR (Fequalp);
+DEFSUBR (Ffill);
+#ifdef SUPPORT_CONFOUNDING_FUNCTIONS
+DEFSUBR (Fold_member);
+DEFSUBR (Fold_memq);
+DEFSUBR (Fold_assoc);
+DEFSUBR (Fold_assq);
+DEFSUBR (Fold_rassoc);
+DEFSUBR (Fold_rassq);
+DEFSUBR (Fold_delete);
+DEFSUBR (Fold_delq);
 DEFSUBR (Fold_equal);
-DEFSUBR (Ffill);
+DEFSUBR (Fold_eq);
+#endif
 DEFSUBR (FassocX);
 DEFSUBR (FrassocX);
 DEFSUBR (Fnconc);

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5473:ac37a5f7e5be