/[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.36 by ttn, Thu Mar 14 03:47:41 2002 UTC revision 1.37 by mvo, Wed May 8 20:11:27 2002 UTC
# Line 66  SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rp Line 66  SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rp
66  }  }
67  #undef FUNC_NAME  #undef FUNC_NAME
68    
69    /* We compare doubles in a special way for 'eqv?' to be able to
70       distinguish plus and minus zero and to identify NaNs.
71    */
72    
73    static int
74    real_eqv (double x, double y)
75    {
76      return !memcmp (&x, &y, sizeof(double));
77    }
78    
79  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
80               (SCM x, SCM y),               (SCM x, SCM y),
# Line 90  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_ Line 99  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_
99          {          {
100            if (SCM_SLOPPY_REALP (x))            if (SCM_SLOPPY_REALP (x))
101              return SCM_BOOL (SCM_SLOPPY_COMPLEXP (y)              return SCM_BOOL (SCM_SLOPPY_COMPLEXP (y)
102                               && SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)                               && real_eqv (SCM_REAL_VALUE (x),
103                                              SCM_COMPLEX_REAL (y))
104                               && 0.0 == SCM_COMPLEX_IMAG (y));                               && 0.0 == SCM_COMPLEX_IMAG (y));
105            else            else
106              return SCM_BOOL (SCM_SLOPPY_REALP (y)              return SCM_BOOL (SCM_SLOPPY_REALP (y)
107                               && SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)                               && real_eqv (SCM_COMPLEX_REAL (x),
108                                              SCM_REAL_VALUE (y))
109                               && SCM_COMPLEX_IMAG (x) == 0.0);                               && SCM_COMPLEX_IMAG (x) == 0.0);
110          }          }
111        return SCM_BOOL_F;        return SCM_BOOL_F;
# Line 104  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_ Line 115  SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_
115        if (SCM_BIGP (x)) {        if (SCM_BIGP (x)) {
116          return SCM_BOOL (0 == scm_bigcomp (x, y));          return SCM_BOOL (0 == scm_bigcomp (x, y));
117        } else if (SCM_SLOPPY_REALP (x)) {        } else if (SCM_SLOPPY_REALP (x)) {
118          return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y));          return SCM_BOOL (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y)));
119        } else { /* complex */        } else { /* complex */
120          return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)          return SCM_BOOL (real_eqv (SCM_COMPLEX_REAL (x),
121                           && SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y));                                     SCM_COMPLEX_REAL (y))
122                             && real_eqv (SCM_COMPLEX_IMAG (x),
123                                          SCM_COMPLEX_IMAG (y)));
124        }        }
125      }      }
126    return SCM_BOOL_F;    return SCM_BOOL_F;

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37

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