home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / bool.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-10-05  |  2.3 KB  |  101 lines
  1. #include "scheme.h"
  2.  
  3. Object P_Booleanp (x) Object x; {
  4.     return TYPE(x) == T_Boolean ? True : False;
  5. }
  6.  
  7. Object P_Not (x) Object x; {
  8.     return Truep (x) ? False : True;
  9. }
  10.  
  11. Object P_Eq (x1, x2) Object x1, x2; {
  12.     return EQ(x1, x2) ? True : False;
  13. }
  14.  
  15. Object P_Eqv (x1, x2) Object x1, x2; {
  16.     return Eqv (x1, x2) ? True : False;
  17. }
  18.  
  19. Object P_Equal (x1, x2) Object x1, x2; {
  20.     return Equal (x1, x2) ? True : False;
  21. }
  22.  
  23. Eqv (x1, x2) Object x1, x2; {
  24.     register t1, t2;
  25.     if (EQ(x1, x2))
  26.     return 1;
  27.     t1 = TYPE(x1);
  28.     t2 = TYPE(x2);
  29.     if (Numeric (t1) && Numeric (t2))
  30.     return Generic_Equal (x1, x2);
  31.     if (t1 != t2)
  32.     return 0;
  33.     switch (t1) {
  34.     case T_String:
  35.         return STRING(x1)->size == 0 && STRING(x2)->size == 0;
  36.     case T_Vector:
  37.     return VECTOR(x1)->size == 0 && VECTOR(x2)->size == 0;
  38.     case T_Primitive:
  39.     return strcmp (PRIM(x1)->name, PRIM(x2)->name) == 0;
  40.     default:
  41.     if (t1 < 0 || t1 >= MAX_TYPE || !Types[t1].name)
  42.         Panic ("bad type in eqv");
  43.     if (Types[t1].eqv == NOFUNC)
  44.         return 0;
  45.     return (*Types[t1].eqv)(x1, x2);
  46.     }
  47.     /*NOTREACHED*/
  48. }
  49.  
  50. Equal (x1, x2) Object x1, x2; {
  51.     register t1, t2, i;
  52.  
  53. again:
  54.     if (EQ(x1, x2))
  55.     return 1;
  56.     t1 = TYPE(x1);
  57.     t2 = TYPE(x2);
  58.     if (Numeric (t1) && Numeric (t2))
  59.     return Generic_Equal (x1, x2);
  60.     if (t1 != t2)
  61.     return 0;
  62.     switch (t1) {
  63.     case T_Boolean:
  64.     case T_Character:
  65.     case T_Compound:
  66.     case T_Control_Point:
  67.     case T_Promise:
  68.     case T_Port:
  69.     case T_Macro:
  70.     return 0;
  71.     case T_Primitive:
  72.     return Eqv (x1, x2);
  73.     case T_Symbol:
  74.     return Equal (SYMBOL(x1)->name, SYMBOL(x2)->name) &&
  75.         Equal (SYMBOL(x1)->plist, SYMBOL(x2)->plist);
  76.     case T_Environment:
  77.     case T_Pair:
  78.     if (!Equal (Car (x1), Car (x2)))
  79.         return 0;
  80.     x1 = Cdr (x1); x2 = Cdr (x2);
  81.     goto again;
  82.     case T_String:
  83.     return STRING(x1)->size == STRING(x2)->size &&
  84.         bcmp (STRING(x1)->data, STRING(x2)->data, STRING(x1)->size) == 0;
  85.     case T_Vector:
  86.     if (VECTOR(x1)->size != VECTOR(x2)->size)
  87.         return 0;
  88.     for (i = 0; i < VECTOR(x1)->size; i++)
  89.         if (!Equal (VECTOR(x1)->data[i], VECTOR(x2)->data[i]))
  90.         return 0;
  91.     return 1;
  92.     default:
  93.     if (t1 < 0 || t1 >= MAX_TYPE || !Types[t1].name)
  94.         Panic ("bad type in equal");
  95.     if (Types[t1].equal == NOFUNC)
  96.         return 0;
  97.     return (*Types[t1].equal)(x1, x2);
  98.     }
  99.     /*NOTREACHED*/
  100. }
  101.