X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/0e12d408bd26355481fae0a66c38d2ef1367cea0..4a1db3a91ff5f2b8947d144f4ed3486d1960b34c:/libguile/eq.c

diff --git a/libguile/eq.c b/libguile/eq.c
index a067c5001..ebc91c93b 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -12,7 +12,7 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 
@@ -30,8 +30,15 @@
 #include "libguile/unif.h"
 #include "libguile/vectors.h"
 
+#include "libguile/struct.h"
+#include "libguile/goops.h"
+#include "libguile/objects.h"
+
 #include "libguile/validate.h"
 #include "libguile/eq.h"
+
+#include "libguile/private-options.h"
+
 
 
 #ifdef HAVE_STRING_H
@@ -41,10 +48,44 @@
 
 SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr,
              (SCM x, SCM y),
-	     "Return @code{#t} iff @var{x} references the same object as @var{y}.\n"
-	     "@code{eq?} is similar to @code{eqv?} except that in some cases it is\n"
-	     "capable of discerning distinctions finer than those detectable by\n"
-	     "@code{eqv?}.")
+	    "Return @code{#t} if @var{x} and @var{y} are the same object,\n"
+	    "except for numbers and characters.  For example,\n"
+	    "\n"
+	    "@example\n"
+	    "(define x (vector 1 2 3))\n"
+	    "(define y (vector 1 2 3))\n"
+	    "\n"
+	    "(eq? x x)  @result{} #t\n"
+	    "(eq? x y)  @result{} #f\n"
+	    "@end example\n"
+	    "\n"
+	    "Numbers and characters are not equal to any other object, but\n"
+	    "the problem is they're not necessarily @code{eq?} to themselves\n"
+	    "either.  This is even so when the number comes directly from a\n"
+	    "variable,\n"
+	    "\n"
+	    "@example\n"
+	    "(let ((n (+ 2 3)))\n"
+	    "  (eq? n n))       @result{} *unspecified*\n"
+	    "@end example\n"
+	    "\n"
+	    "Generally @code{eqv?} should be used when comparing numbers or\n"
+	    "characters.  @code{=} or @code{char=?} can be used too.\n"
+	    "\n"
+	    "It's worth noting that end-of-list @code{()}, @code{#t},\n"
+	    "@code{#f}, a symbol of a given name, and a keyword of a given\n"
+	    "name, are unique objects.  There's just one of each, so for\n"
+	    "instance no matter how @code{()} arises in a program, it's the\n"
+	    "same object and can be compared with @code{eq?},\n"
+	    "\n"
+	    "@example\n"
+	    "(define x (cdr '(123)))\n"
+	    "(define y (cdr '(456)))\n"
+	    "(eq? x y) @result{} #t\n"
+	    "\n"
+	    "(define x (string->symbol \"foo\"))\n"
+	    "(eq? x 'foo) @result{} #t\n"
+	    "@end example")
 #define FUNC_NAME s_scm_eq_p
 {
   return scm_from_bool (scm_is_eq (x, y));
@@ -64,11 +105,22 @@ real_eqv (double x, double y)
 #include <stdio.h>
 SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
              (SCM x, SCM y),
-	     "The @code{eqv?} procedure defines a useful equivalence relation on objects.\n"
-	     "Briefly, it returns @code{#t} if @var{x} and @var{y} should normally be\n"
-	     "regarded as the same object.  This relation is left slightly open to\n"
-	     "interpretation, but works for comparing immediate integers, characters,\n"
-	     "and inexact numbers.")
+	    "Return @code{#t} if @var{x} and @var{y} are the same object, or\n"
+	    "for characters and numbers the same value.\n"
+	    "\n"
+	    "On objects except characters and numbers, @code{eqv?} is the\n"
+	    "same as @code{eq?}, it's true if @var{x} and @var{y} are the\n"
+	    "same object.\n"
+	    "\n"
+	    "If @var{x} and @var{y} are numbers or characters, @code{eqv?}\n"
+	    "compares their type and value.  An exact number is not\n"
+	    "@code{eqv?} to an inexact number (even if their value is the\n"
+	    "same).\n"
+	    "\n"
+	    "@example\n"
+	    "(eqv? 3 (+ 1 2)) @result{} #t\n"
+	    "(eqv? 1 1.0)     @result{} #f\n"
+	    "@end example")
 #define FUNC_NAME s_scm_eqv_p
 {
   if (scm_is_eq (x, y))
@@ -130,12 +182,41 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
 
 SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
 			 (SCM x, SCM y),
- "Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} equivalent.\n"
- "@code{equal?} recursively compares the contents of pairs,\n"
- "vectors, and strings, applying @code{eqv?} on other objects such as\n"
- "numbers and symbols.  A rule of thumb is that objects are generally\n"
- "@code{equal?}  if they print the same.  @code{equal?} may fail to\n"
- "terminate if its arguments are circular data structures.")
+	    "Return @code{#t} if @var{x} and @var{y} are the same type, and\n"
+	    "their contents or value are equal.\n"
+	    "\n"
+	    "For a pair, string, vector or array, @code{equal?} compares the\n"
+	    "contents, and does so using using the same @code{equal?}\n"
+	    "recursively, so a deep structure can be traversed.\n"
+	    "\n"
+	    "@example\n"
+	    "(equal? (list 1 2 3) (list 1 2 3))   @result{} #t\n"
+	    "(equal? (list 1 2 3) (vector 1 2 3)) @result{} #f\n"
+	    "@end example\n"
+	    "\n"
+	    "For other objects, @code{equal?} compares as per @code{eqv?},\n"
+	    "which means characters and numbers are compared by type and\n"
+	    "value (and like @code{eqv?}, exact and inexact numbers are not\n"
+	    "@code{equal?}, even if their value is the same).\n"
+	    "\n"
+	    "@example\n"
+	    "(equal? 3 (+ 1 2)) @result{} #t\n"
+	    "(equal? 1 1.0)     @result{} #f\n"
+	    "@end example\n"
+	    "\n"
+	    "Hash tables are currently only compared as per @code{eq?}, so\n"
+	    "two different tables are not @code{equal?}, even if their\n"
+	    "contents are the same.\n"
+	    "\n"
+	    "@code{equal?} does not support circular data structures, it may\n"
+	    "go into an infinite loop if asked to compare two circular lists\n"
+	    "or similar.\n"
+	    "\n"
+	    "New application-defined object types (Smobs) have an\n"
+	    "@code{equalp} handler which is called by @code{equal?}.  This\n"
+	    "lets an application traverse the contents or control what is\n"
+	    "considered @code{equal?} for two such objects.  If there's no\n"
+	    "handler, the default is to just compare as per @code{eq?}.")
 #define FUNC_NAME s_scm_equal_p
 {
   SCM_CHECK_STACK;
@@ -147,7 +228,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
     return SCM_BOOL_F;
   if (SCM_IMP (y))
     return SCM_BOOL_F;
-  if (SCM_CONSP (x) && SCM_CONSP (y))
+  if (scm_is_pair (x) && scm_is_pair (y))
     {
       if (scm_is_false (scm_equal_p (SCM_CAR (x), SCM_CAR (y))))
 	return SCM_BOOL_F;
@@ -157,6 +238,16 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
     }
   if (SCM_TYP7 (x) == scm_tc7_string && SCM_TYP7 (y) == scm_tc7_string)
     return scm_string_equal_p (x, y);
+  if (SCM_TYP7 (x) == scm_tc7_smob && SCM_TYP16 (x) == SCM_TYP16 (y))
+    {
+      int i = SCM_SMOBNUM (x);
+      if (!(i < scm_numsmob))
+	return SCM_BOOL_F;
+      if (scm_smobs[i].equalp)
+	return (scm_smobs[i].equalp) (x, y);
+      else
+	goto generic_equal;
+    }
   /* This ensures that types and scm_length are the same.  */
   if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y))
     {
@@ -173,6 +264,11 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
 			     && SCM_COMPLEX_IMAG (x) == 0.0);
 	}
 
+      /* Vectors can be equal to one-dimensional arrays.
+       */
+      if (SCM_I_ARRAYP (x) || SCM_I_ARRAYP (y))
+	return scm_array_equal_p (x, y);
+
       return SCM_BOOL_F;
     }
   switch (SCM_TYP7 (x))
@@ -193,29 +289,16 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
         }
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      return scm_vector_equal_p (x, y);
-    case scm_tc7_smob:
-      {
-	int i = SCM_SMOBNUM (x);
-	if (!(i < scm_numsmob))
-	  return SCM_BOOL_F;
-	if (scm_smobs[i].equalp)
-	  return (scm_smobs[i].equalp) (x, y);
-	else
-	  break;
-      }
-#if SCM_HAVE_ARRAYS
-    case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
-    case scm_tc7_fvect:	case scm_tc7_cvect: case scm_tc7_dvect:
-    case scm_tc7_svect:
-#if SCM_SIZEOF_LONG_LONG != 0
-    case scm_tc7_llvect:
-#endif
-    case scm_tc7_byvect:
-      if (scm_tc16_array && scm_smobs[SCM_TC2SMOBNUM (scm_tc16_array)].equalp)
-	return scm_array_equal_p (x, y);
-#endif
+      return scm_i_vector_equal_p (x, y);
     }
+
+  /* Check equality between structs of equal type (see cell-type test above)
+     that are not GOOPS instances.  GOOPS instances are treated via the
+     generic function.  */
+  if ((SCM_STRUCTP (x)) && (!SCM_INSTANCEP (x)))
+    return scm_i_struct_equalp (x, y);
+
+ generic_equal:
   if (SCM_UNPACK (g_scm_equal_p))
     return scm_call_generic_2 (g_scm_equal_p, x, y);
   else