mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

* tests/goops.test: New tests.

Browse source 
* goops.scm (equal?): Provide default method for `equal?'.
(compute-getters-n-setters): Check for bad init-thunks.

* eq.c (scm_equal_p): Turned into a primitive generic.

* snarf.h (SCM_PRIMITIVE_GENERIC, SCM_PRIMITIVE_GENERIC_1): New
macros.
This commit is contained in:
Mikael Djurfeldt 2003-04-17 17:50:57 +00:00
parent 95a0ecc3c7
commit 071d6b0ecc
8 changed files with 285 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/eq.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -115,14 +115,14 @@ SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
#undef FUNC_NAME
SCM_DEFINE1 (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.")
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.")
#define FUNC_NAME s_scm_equal_p
{
SCM_CHECK_STACK;
@ -164,7 +164,7 @@ SCM_DEFINE1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
switch (SCM_TYP7 (x))
{
default:
return SCM_BOOL_F;
break;
case scm_tc7_vector:
case scm_tc7_wvect:
return scm_vector_equal_p (x, y);
@ -176,7 +176,7 @@ SCM_DEFINE1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
if (scm_smobs[i].equalp)
return (scm_smobs[i].equalp) (x, y);
else
return SCM_BOOL_F;
break;
}
#ifdef HAVE_ARRAYS
case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
@ -190,7 +190,10 @@ SCM_DEFINE1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
return scm_array_equal_p (x, y);
#endif
}
return SCM_BOOL_F;
if (SCM_UNPACK (g_scm_equal_p))
return scm_call_generic_2 (g_scm_equal_p, x, y);
else
return SCM_BOOL_F;
}
#undef FUNC_NAME