Implementation of SRFI-98 (An interface to access environment variables).
[bpt/guile.git] / libguile / eq.c
index bde9a57..b54a704 100644 (file)
@@ -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
  *
  * 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
  */
 
 \f
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
 #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"
+
 \f
 
 #ifdef HAVE_STRING_H
 
 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;
@@ -183,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))
@@ -203,18 +289,15 @@ 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);
-#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
-      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);