Adding assoc/member C functions back

This commit is contained in:
Justin Ethier 2016-10-15 17:57:46 -04:00
parent 5d7051819a
commit 54a47242bf
2 changed files with 52 additions and 0 deletions

View file

@ -279,6 +279,10 @@ object Cyc_num_op_va_list(void *data, int argc,
va_list ns, common_type * buf); va_list ns, common_type * buf);
int equal(object, object); int equal(object, object);
object equalp(object, object); object equalp(object, object);
object memberp(void *data, object x, list l);
object memqp(void *data, object x, list l);
list assq(void *data, object x, list l);
list assoc(void *data, object x, list l);
object Cyc_spawn_thread(object thunk); object Cyc_spawn_thread(object thunk);
void Cyc_start_trampoline(gc_thread_data * thd); void Cyc_start_trampoline(gc_thread_data * thd);

View file

@ -1000,6 +1000,54 @@ object Cyc_write_char(void *data, object c, object port)
return quote_void; return quote_void;
} }
/* Fast versions of member and assoc */
object memberp(void *data, object x, list l)
{
Cyc_check_pair_or_null(data, l);
for (; l != NULL; l = cdr(l)) {
if (boolean_f != equalp(x, car(l)))
return boolean_t;
}
return boolean_f;
}
object memqp(void *data, object x, list l)
{
Cyc_check_pair_or_null(data, l);
for (; l != NULL; l = cdr(l)) {
if ((x == car(l)))
return boolean_t;
}
return boolean_f;
}
list assq(void *data, object x, list l)
{
if ((l == NULL) || is_value_type(l) || type_of(l) != pair_tag)
return boolean_f;
for (; (l != NULL); l = cdr(l)) {
list la = car(l);
Cyc_check_pair(data, la);
if ((x == car(la)))
return la;
}
return boolean_f;
}
list assoc(void *data, object x, list l)
{
if ((l == NULL) || is_value_type(l) || type_of(l) != pair_tag)
return boolean_f;
for (; (l != NULL); l = cdr(l)) {
list la = car(l);
Cyc_check_pair(data, la);
if (boolean_f != equalp(x, car(la)))
return la;
}
return boolean_f;
}
/* END member and assoc */
// Internal function, do not use this anywhere outside the runtime // Internal function, do not use this anywhere outside the runtime
object Cyc_heap_alloc_port(void *data, port_type *stack_p) object Cyc_heap_alloc_port(void *data, port_type *stack_p)
{ {