1 |
/* 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. |
2 |
* |
* |
3 |
* This program is free software; you can redistribute it and/or modify |
* This program is free software; you can redistribute it and/or modify |
4 |
* it under the terms of the GNU General Public License as published by |
* it under the terms of the GNU General Public License as published by |
134 |
#undef FUNC_NAME |
#undef FUNC_NAME |
135 |
|
|
136 |
|
|
137 |
SCM_DEFINE1 (scm_equal_p, "equal?", scm_tc7_rpsubr, |
SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, |
138 |
(SCM x, SCM y), |
(SCM x, SCM y), |
139 |
"Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} equivalent.\n" |
"Return @code{#t} iff @var{x} and @var{y} are recursively @code{eqv?} equivalent.\n" |
140 |
"@code{equal?} recursively compares the contents of pairs,\n" |
"@code{equal?} recursively compares the contents of pairs,\n" |
141 |
"vectors, and strings, applying @code{eqv?} on other objects such as\n" |
"vectors, and strings, applying @code{eqv?} on other objects such as\n" |
142 |
"numbers and symbols. A rule of thumb is that objects are generally\n" |
"numbers and symbols. A rule of thumb is that objects are generally\n" |
143 |
"@code{equal?} if they print the same. @code{equal?} may fail to\n" |
"@code{equal?} if they print the same. @code{equal?} may fail to\n" |
144 |
"terminate if its arguments are circular data structures.") |
"terminate if its arguments are circular data structures.") |
145 |
#define FUNC_NAME s_scm_equal_p |
#define FUNC_NAME s_scm_equal_p |
146 |
{ |
{ |
147 |
SCM_CHECK_STACK; |
SCM_CHECK_STACK; |
183 |
switch (SCM_TYP7 (x)) |
switch (SCM_TYP7 (x)) |
184 |
{ |
{ |
185 |
default: |
default: |
186 |
return SCM_BOOL_F; |
break; |
187 |
case scm_tc7_vector: |
case scm_tc7_vector: |
188 |
case scm_tc7_wvect: |
case scm_tc7_wvect: |
189 |
return scm_vector_equal_p (x, y); |
return scm_vector_equal_p (x, y); |
195 |
if (scm_smobs[i].equalp) |
if (scm_smobs[i].equalp) |
196 |
return (scm_smobs[i].equalp) (x, y); |
return (scm_smobs[i].equalp) (x, y); |
197 |
else |
else |
198 |
return SCM_BOOL_F; |
break; |
199 |
} |
} |
200 |
#ifdef HAVE_ARRAYS |
#ifdef HAVE_ARRAYS |
201 |
case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect: |
case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect: |
209 |
return scm_array_equal_p (x, y); |
return scm_array_equal_p (x, y); |
210 |
#endif |
#endif |
211 |
} |
} |
212 |
return SCM_BOOL_F; |
if (SCM_UNPACK (g_scm_equal_p)) |
213 |
|
return scm_call_generic_2 (g_scm_equal_p, x, y); |
214 |
|
else |
215 |
|
return SCM_BOOL_F; |
216 |
} |
} |
217 |
#undef FUNC_NAME |
#undef FUNC_NAME |
218 |
|
|