xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 4962:e813cf16c015

merge

author	Ben Wing <ben@xemacs.org>
date	Mon, 01 Feb 2010 05:29:05 -0600
parents	19a72041c5ed 6ef8256a020a
children	48b63cd88a21

comparison

equal deleted inserted replaced

-:b90f8cf474e0
+:e813cf16c015
 if (last != len)
 write_ascstring (printcharfun, "...");
 }
 static int
-bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth))
+bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
+		  int UNUSED (foldcase))
 {
 Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1);
 Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2);
 return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
 NIL_MEANS_NOT_PRESENT is as in `plists-eq' etc.
 LAXP means use `equal' for comparisons.
 */
 int
 plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present,
-	       int laxp, int depth)
+	       int laxp, int depth, int foldcase)
 {
 int eqp = (depth == -1);	/* -1 as depth means use eq, not equal. */
 int la, lb, m, i, fill;
 Lisp_Object *keys, *vals;
 char *flags;
 Lisp_Object v = XCAR (XCDR (rest));
 /* Maybe be Ebolified. */
 if (nil_means_not_present && NILP (v)) continue;
 for (i = 0; i < fill; i++)
 	{
-	  if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth))
+	  if (!laxp ? EQ (k, keys [i]) :
+	      internal_equal_0 (k, keys [i], depth, foldcase))
 	    {
 	      if (eqp
 		  /* We narrowly escaped being Ebolified here. */
 		  ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
-		  : !internal_equal (v, vals [i], depth))
+		  : !internal_equal_0 (v, vals [i], depth, foldcase))
 		/* a property in B has a different value than in A */
 		goto MISMATCH;
 	      flags [i] = 1;
 	      break;
 	    }
 old Lisp implementations, but should not be used except for backward
 compatibility.
 */
 (a, b, nil_means_not_present))
 {
-return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1)
+return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1, 0)
 	  ? Qnil : Qt);
 }
 DEFUN ("plists-equal", Fplists_equal, 2, 3, 0, /*
 Return non-nil if property lists A and B are `equal'.
 old Lisp implementations, but should not be used except for backward
 compatibility.
 */
 (a, b, nil_means_not_present))
 {
-return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1)
+return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1, 0)
 	  ? Qnil : Qt);
 }
 DEFUN ("lax-plists-eq", Flax_plists_eq, 2, 3, 0, /*
 old Lisp implementations, but should not be used except for backward
 compatibility.
 */
 (a, b, nil_means_not_present))
 {
-return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1)
+return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1, 0)
 	  ? Qnil : Qt);
 }
 DEFUN ("lax-plists-equal", Flax_plists_equal, 2, 3, 0, /*
 Return non-nil if lax property lists A and B are `equal'.
 old Lisp implementations, but should not be used except for backward
 compatibility.
 */
 (a, b, nil_means_not_present))
 {
-return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1)
+return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1, 0)
 	  ? Qnil : Qt);
 }
 /* Return the value associated with key PROPERTY in property list PLIST.
 Return nil if key not found.  This function is used for internal
 	*imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
 	*imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
 return (imp1 == imp2) &&
 	/* EQ-ness of the objects was noticed above */
-	(imp1->equal && (imp1->equal) (obj1, obj2, depth));
+	(imp1->equal && (imp1->equal) (obj1, obj2, depth, 0));
 }
 return 0;
+}
+enum array_type
+{
+ARRAY_NONE = 0,
+ARRAY_STRING,
+ARRAY_VECTOR,
+ARRAY_BIT_VECTOR
+};
+static enum array_type
+array_type (Lisp_Object obj)
+{
+if (STRINGP (obj))
+return ARRAY_STRING;
+if (VECTORP (obj))
+return ARRAY_VECTOR;
+if (BIT_VECTORP (obj))
+return ARRAY_BIT_VECTOR;
+return ARRAY_NONE;
 }
 int
 internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
 if (depth > 200)
 stack_overflow ("Stack overflow in equalp", Qunbound);
 QUIT;
+/* 1. Objects that are `eq' are equal.  This will catch the common case
+of two equal fixnums or the same object seen twice. */
 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
 return 1;
-#ifdef WITH_NUMBER_TYPES
+/* 2. If both numbers, compare with `='. */
 if (NUMBERP (obj1) && NUMBERP (obj2))
 {
-switch (promote_args (&obj1, &obj2))
+Lisp_Object args[2];
-	{
+args[0] = obj1;
-	case FIXNUM_T:
+args[1] = obj2;
-	  return XREALINT (obj1) == XREALINT (obj2);
+return !NILP (Feqlsign (2, args));
-#ifdef HAVE_BIGNUM
+}
-	case BIGNUM_T:
-	  return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
+/* 3. If characters, compare case-insensitively. */
-#endif
-#ifdef HAVE_RATIO
-	case RATIO_T:
-	  return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
-#endif
-	case FLOAT_T:
-	  return XFLOAT_DATA (obj1) == XFLOAT_DATA (obj2);
-#ifdef HAVE_BIGFLOAT
-	case BIGFLOAT_T:
-	  return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
-#endif
-	}
-}
-#else
-if ((INTP (obj1) && FLOATP (obj2)) || (FLOATP (obj1) && INTP (obj2)))
-return extract_float (obj1) == extract_float (obj2);
-#endif
 if (CHARP (obj1) && CHARP (obj2))
 return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2));
+/* 4. If arrays of different types, compare their lengths, and
+then compare element-by-element. */
+{
+enum array_type artype1, artype2;
+artype1 = array_type (obj1);
+artype2 = array_type (obj2);
+if (artype1 != artype2 && artype1 && artype2)
+{
+	EMACS_INT i;
+	EMACS_INT l1 = XINT (Flength (obj1));
+	EMACS_INT l2 = XINT (Flength (obj2));
+	/* Both arrays, but of different types */
+	if (l1 != l2)
+	  return 0;
+	for (i = 0; i < l1; i++)
+	  if (!internal_equalp (Faref (obj1, make_int (i)),
+				Faref (obj2, make_int (i)), depth + 1))
+	    return 0;
+	return 1;
+}
+}
+/* 5. Else, they must be the same type.  If so, call the equal() method,
+telling it to fold case.  For objects that care about case-folding
+	their contents, the equal() method will call internal_equal_0(). */
 if (XTYPE (obj1) != XTYPE (obj2))
 return 0;
 if (LRECORDP (obj1))
 {
 const struct lrecord_implementation
 	*imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
 	*imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
-/* #### not yet implemented properly, needs another flag to specify
-	 equalp-ness */
 return (imp1 == imp2) &&
 	/* EQ-ness of the objects was noticed above */
-	(imp1->equal && (imp1->equal) (obj1, obj2, depth));
+	(imp1->equal && (imp1->equal) (obj1, obj2, depth, 1));
 }
 return 0;
+}
+int
+internal_equal_0 (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
+{
+if (foldcase)
+return internal_equalp (obj1, obj2, depth);
+else
+return internal_equal (obj1, obj2, depth);
 }
 /* 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,
 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;
 }
 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.
 DEFSUBR (Fget);
 DEFSUBR (Fput);
 DEFSUBR (Fremprop);
 DEFSUBR (Fobject_plist);
 DEFSUBR (Fequal);
+DEFSUBR (Fequalp);
 DEFSUBR (Fold_equal);
 DEFSUBR (Ffillarray);
 DEFSUBR (Fnconc);
 DEFSUBR (Fmapcar);
 DEFSUBR (Fmapvector);

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 4962:e813cf16c015