Merge commit 'f30e1bdf97ae8b2b2918da585f887a4d3a23a347' into boehm-demers-weiser-gc

[bpt/guile.git] / libguile / eq.c

diff --git a/libguile/eq.c b/libguile/eq.c
index e0726a0..7c7e76d 100644 (file)
--- 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
  */
 
 \f
@@ -30,6 +30,10 @@
 #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"
 \f
@@ -257,6 +261,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))
@@ -277,8 +286,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);
+      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);