term lambda_1 (term v, term x)
{
term f, a;
type tf;
if (v->k != TERM_VAR)
{
sput ("lambda: 1st arg not variable\n", err);
return UNDEF_TERM;
}
if (x->k == TERM_VAR && !strcmp (x->var.name, v->var.name) &&
equal_type (x->var.typ, v->var.typ))
return I (v->var.typ);
if (!occur (v, x))
return ap (K (type_term (x), v->var.typ), x);
f = x->ap.fnc;
a = x->ap.arg;
if (a->k == TERM_VAR && !strcmp (a->var.name, v->var.name) &&
equal_type (a->var.typ, v->var.typ) &&
!occur (v, f))
return f;
tf = type_term (f);
return ap (ap (S (v->var.typ, type_term (a), tf->fnc.res),
lambda (v, f)),
lambda (v, a));
}
int equal_type (type a, type b)
{
if (a->k != b->k)
return 0;
if (a->k != TYPE_FNC)
return 1;
if (!equal_type (a->fnc.arg, b->fnc.arg))
return 0;
if (!equal_type (a->fnc.res, b->fnc.res))
return 0;
return 1;
}
int occur (term v, term x)
{
if (x->k == TERM_VAR && !strcmp (x->var.name, v->var.name) &&
equal_type (x->var.typ, v->var.typ))
return 1;
if (x->k != TERM_AP)
return 0;
if (occur (v, x->ap.fnc))
return 1;
if (occur (v, x->ap.arg))
return 1;
return 0;
}
term ap (term fnc, term arg)
{
type tf, ta;
tf = type_term (fnc);
if (tf->k != TYPE_FNC)
sput ("ap: invalid function\n", err);
ta = type_term (arg);
if (!equal_type (ta, tf->fnc.arg))
{
sput ("ap: bad type\n\tfunction ", err);
write_term (fnc, err);
sput (" has type ", err);
write_type (tf, err);
sput ("\n\targument ", err);
write_term (arg, err);
sput (" has type ", err);
write_type (ta, err);
sput ("\n", err);
}
return ap1 (fnc, arg);
}
bool
hash_table<T, Hash, Equals, Allocator>::
equals(const_reference x1, const_reference x2)
{
return equal_type()(x1, x2);
}
