root/src/boolean.c

DEFINITIONS

1. Scm_EqP
2. Scm_EqvP
3. Scm_EqualP
4. Scm_EqualM

   1 /*
   2  * boolean.c
   3  *
   4  *   Copyright (c) 2000-2004 Shiro Kawai, All rights reserved.
   5  * 
   6  *   Redistribution and use in source and binary forms, with or without
   7  *   modification, are permitted provided that the following conditions
   8  *   are met:
   9  * 
  10  *   1. Redistributions of source code must retain the above copyright
  11  *      notice, this list of conditions and the following disclaimer.
  12  *
  13  *   2. Redistributions in binary form must reproduce the above copyright
  14  *      notice, this list of conditions and the following disclaimer in the
  15  *      documentation and/or other materials provided with the distribution.
  16  *
  17  *   3. Neither the name of the authors nor the names of its contributors
  18  *      may be used to endorse or promote products derived from this
  19  *      software without specific prior written permission.
  20  *
  21  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  22  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  23  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  24  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  25  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  26  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
  27  *   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  28  *   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  29  *   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  30  *   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  31  *   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32  *
  33  *  $Id: boolean.c,v 1.22 2004/01/17 01:34:48 shirok Exp $
  34  */
  36 #define LIBGAUCHE_BODY
  37 #include "gauche.h"
  39 int Scm_EqP(ScmObj x, ScmObj y)
  40 {
  41     return SCM_EQ(x, y);
  42 }
  44 int Scm_EqvP(ScmObj x, ScmObj y)
  45 {
  46     /* for our implementation, only the number matters. */
  47     if (SCM_NUMBERP(x)) {
  48         if (SCM_NUMBERP(y)) {
  49             if ((SCM_EXACTP(x) && SCM_EXACTP(y))
  50                 || (SCM_INEXACTP(x) && SCM_INEXACTP(y))) {
  51                 return Scm_NumEq(x, y);
  52             }
  53         }
  54         return FALSE;
  55     }
  56     return SCM_EQ(x, y);
  57 }
  59 int Scm_EqualP(ScmObj x, ScmObj y)
  60 {
ScmClass *cx, *cy;
  63     if (SCM_EQ(x, y)) return TRUE;
  64     if (SCM_PAIRP(x)) {
  65         if (!SCM_PAIRP(y)) return FALSE;
  66         do {
  67             if (!Scm_EqualP(SCM_CAR(x), SCM_CAR(y))) return FALSE;
x = SCM_CDR(x);
y = SCM_CDR(y);
  70         } while (SCM_PAIRP(x)&&SCM_PAIRP(y));
  71         return Scm_EqualP(x, y);
  72    }
  73     if (SCM_STRINGP(x)) {
  74         if (SCM_STRINGP(y)) {
  75             return Scm_StringEqual(SCM_STRING(x), SCM_STRING(y));
  76         }
  77         return FALSE;
  78     }
  79     if (SCM_NUMBERP(x)) {
  80         if (SCM_NUMBERP(y)) {
  81             if ((SCM_EXACTP(x) && SCM_EXACTP(y))
  82                 || (SCM_INEXACTP(x) && SCM_INEXACTP(y))) {
  83                 return Scm_NumEq(x, y);
  84             }
  85         }
  86         return FALSE;
  87     }
  88     if (SCM_VECTORP(x)) {
  89         if (SCM_VECTORP(y)) {
  90             int sizx = SCM_VECTOR_SIZE(x);
  91             int sizy = SCM_VECTOR_SIZE(y);
  92             if (sizx == sizy) {
  93                 while (sizx--) {
  94                     if (!Scm_EqualP(SCM_VECTOR_ELEMENT(x, sizx),
SCM_VECTOR_ELEMENT(y, sizx)))
  96                         break;
  97                 }
  98                 if (sizx < 0) return TRUE;
  99             }
 100         }
 101         return FALSE;
 102     }
 103     /* EXPERIMENTAL: when identifier is compared by equal?,
 104        we use its symbolic name to compare.  This allows
 105        comparing macro output with equal?, and also less confusing
 106        when R5RS macro and legacy macro are mixed.
 107        For "proper" comparison of identifiers keeping their semantics,
 108        we need such procedures as free-identifier=? and bound-identifier=?
 109        anyway, so this change of equal? won't have a negative impact, I hope.
 110 
 111        NB: this operation come here instead of the beginning of this
 112        procedure, since comparing identifiers are relatively rare so
 113        we don't want to check idnetifier-ness every time.
 114     */
 115     if (SCM_IDENTIFIERP(x) || SCM_IDENTIFIERP(y)) {
 116         if (SCM_IDENTIFIERP(x)) x = SCM_OBJ(SCM_IDENTIFIER(x)->name);
 117         if (SCM_IDENTIFIERP(y)) y = SCM_OBJ(SCM_IDENTIFIER(y)->name);
 118         return SCM_EQ(x, y);
 119     }
 120     /* End of EXPERIMENTAL code */
 122     if (!SCM_PTRP(x)) return (x == y);
cx = Scm_ClassOf(x);
cy = Scm_ClassOf(y);
 125     if (cx == cy && cx->compare) {
 126         return (cx->compare(x, y, TRUE) == 0);
 127     }
 128     return FALSE;
 129 }
 131 int Scm_EqualM(ScmObj x, ScmObj y, int mode)
 132 {
 133     switch (mode) {
 134     case SCM_CMP_EQ:
 135         return SCM_EQ(x, y);
 136     case SCM_CMP_EQV:
 137         return Scm_EqvP(x, y);
 138     case SCM_CMP_EQUAL:
 139         return Scm_EqualP(x, y);
 140     }
 141     return FALSE;
 142 }