Files
glisp/src/list.c

86 lines
2.1 KiB
C

#include "list.h"
intptr_t list_length(LispVal *list) {
assert(LISTP(list));
LispVal *tortise = list;
LispVal *hare = list;
intptr_t length = 0;
while (CONSP(tortise)) {
tortise = XCDR_SAFE(tortise);
hare = XCDR_SAFE(XCDR_SAFE(hare));
if (!NILP(hare) && tortise == hare) {
return -1;
}
++length;
}
return length;
}
bool list_length_eq(LispVal *list, intptr_t size) {
while (size && CONSP(list)) {
list = XCDR(list);
--size;
}
return size == 0 && NILP(list);
}
DEFUN(cons, "cons", (LispVal * car, LispVal *cdr), "(car cdr)",
"Construct a new cons object from CAR and CDR.") {
return CONS(car, cdr);
}
DEFUN(length, "length", (LispVal * list), "(list)", "") {
// TODO type check
// TODO list may be circular
return MAKE_FIXNUM(list_length(list));
}
DEFUN(length_eq, "length=", (LispVal * list, LispVal *length), "(list length)",
"Return non-nil if LIST's length is LENGTH.") {
// TODO type check
return list_length_eq(list, XFIXNUM(length)) ? Qt : Qnil;
}
DEFUN(nreverse, "nreverse", (LispVal * list), "(list)", "") {
// TODO type checking
LispVal *rev = Qnil;
while (!NILP(list)) {
LispVal *next = XCDR(list);
RPLACD(list, rev);
rev = list;
list = next;
}
return rev;
}
DEFUN(listp, "listp", (LispVal * obj), "(obj)", "") {
return LISTP(obj) ? Qt : Qnil;
}
DEFUN(list, "list", (LispVal * args), "(&rest args)", "") {
return args;
}
DEFUN(plist_put, "plist-put", (LispVal * plist, LispVal *prop, LispVal *value),
"(plist prop value)", "") {
CHECK_LISTP(plist);
DOTAILS(rest, plist) {
if (EQ(XCAR(rest), prop)) {
RPLACA(XCDR(rest), value);
return plist;
}
}
return CONS(prop, CONS(value, plist));
}
DEFUN(plist_get, "plist-get", (LispVal * plist, LispVal *prop, LispVal *def),
"(plist prop &optional default)", "") {
CHECK_LISTP(plist);
DOTAILS(rest, plist) {
if (EQ(XCAR(rest), prop)) {
return SECOND(rest);
}
}
return def;
}