elk/src/bool.c

#include "kernel.h"

#include <string.h>

extern int Generic_Equal (Object, Object);

Object P_Booleanp (Object x) {
    return TYPE(x) == T_Boolean ? True : False;
}

Object P_Not (Object x) {
    return Truep (x) ? False : True;
}

Object P_Eq (Object x1, Object x2) {
    return EQ(x1, x2) ? True : False;
}

Object P_Eqv (Object x1, Object x2) {
    return Eqv (x1, x2) ? True : False;
}

Object P_Equal (Object x1, Object x2) {
    return Equal (x1, x2) ? True : False;
}

int Eqv (Object x1, Object x2) {
    register int t1, t2;
    if (EQ(x1, x2))
	return 1;
    t1 = TYPE(x1);
    t2 = TYPE(x2);
    if (Numeric (t1) && Numeric (t2))
	return Generic_Equal (x1, x2);
    if (t1 != t2)
	return 0;
    switch (t1) {
    case T_String:
        return STRING(x1)->size == 0 && STRING(x2)->size == 0;
    case T_Vector:
	return VECTOR(x1)->size == 0 && VECTOR(x2)->size == 0;
    case T_Primitive:
	return strcmp (PRIM(x1)->name, PRIM(x2)->name) == 0;
    default:
	if (t1 < 0 || t1 >= Num_Types)
	    Panic ("bad type in eqv");
	if (Types[t1].eqv == NOFUNC)
	    return 0;
	return (Types[t1].eqv)(x1, x2);
    }
    /*NOTREACHED*/
}

int Equal (Object x1, Object x2) {
    register int t1, t2, i;

again:
    if (EQ(x1, x2))
	return 1;
    t1 = TYPE(x1);
    t2 = TYPE(x2);
    if (Numeric (t1) && Numeric (t2))
	return Generic_Equal (x1, x2);
    if (t1 != t2)
	return 0;
    switch (t1) {
    case T_Boolean:
    case T_Character:
    case T_Compound:
    case T_Control_Point:
    case T_Promise:
    case T_Port:
    case T_Macro:
	return 0;
    case T_Primitive:
    case T_Environment:
	return Eqv (x1, x2);
    case T_Symbol: {
	struct S_Symbol *p1 = SYMBOL(x1), *p2 = SYMBOL(x2);
	return Equal (p1->name, p2->name) && Equal (p1->plist, p2->plist);
    }
    case T_Pair:
	if (!Equal (Car (x1), Car (x2)))
	    return 0;
	x1 = Cdr (x1); x2 = Cdr (x2);
	goto again;
    case T_String: {
	struct S_String *p1 = STRING(x1), *p2 = STRING(x2);
	return p1->size == p2->size &&
	    bcmp (p1->data, p2->data, p1->size) == 0;
    }
    case T_Vector: {
	struct S_Vector *p1 = VECTOR(x1), *p2 = VECTOR(x2);
	if (p1->size != p2->size)
	    return 0;
	for (i = 0; i < p1->size; i++)
	    if (!Equal (p1->data[i], p2->data[i]))
		return 0;
	return 1;
    }
    default:
	if (t1 < 0 || t1 >= Num_Types)
	    Panic ("bad type in equal");
	if (Types[t1].equal == NOFUNC)
	    return 0;
	return (Types[t1].equal)(x1, x2);
    }
    /*NOTREACHED*/
}

Object P_Empty_List_Is_False (Object is_false) {
    Check_Type (is_false, T_Boolean);
    if (Truep (is_false))
	False2 = Null;
    else
	False2 = False;
    return Void;
}