/[guile]/guile/guile-core/libguile/eq.c
ViewVC logotype

Diff of /guile/guile-core/libguile/eq.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.38 by ghouston, Wed Jul 10 22:25:55 2002 UTC revision 1.39 by mdj, Thu Mar 6 12:50:41 2003 UTC
# Line 1  Line 1 
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
# Line 134  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_ Line 134  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_
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;
# Line 183  SCM_DEFINE1 (scm_equal_p, "equal?", scm_ Line 183  SCM_DEFINE1 (scm_equal_p, "equal?", scm_
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);
# Line 195  SCM_DEFINE1 (scm_equal_p, "equal?", scm_ Line 195  SCM_DEFINE1 (scm_equal_p, "equal?", scm_
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:
# Line 209  SCM_DEFINE1 (scm_equal_p, "equal?", scm_ Line 209  SCM_DEFINE1 (scm_equal_p, "equal?", scm_
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    

Legend:
Removed from v.1.38  
changed lines
  Added in v.1.39

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26