diff --git a/doc/stdlib_data.md b/doc/stdlib_data.md index 5be753b..7e02bf6 100644 --- a/doc/stdlib_data.md +++ b/doc/stdlib_data.md @@ -11,15 +11,29 @@ These functions operate on various data structures in Keithlisp. ``` (car cons) ``` -`car` returns the `car` portion of `cons`, or nil if the argument is not -a cons. +`car` returns the car portion of `cons`, or nil if the argument is not a +cons. ## `cdr` ``` (cdr cons) ``` -`cdr` returns the `cdr` portion of `cons`, or nil if the argument is not -a cons. +`cdr` returns the cdr portion of `cons`, or nil if the argument is not a +cons. + +## `rplaca` +``` +(rplaca cons value) +``` +`rplaca` changes the car portion of `cons` to `value`. It returns the +same `cons` it was given. + +## `rplacd` +``` +(rplacd cons value) +``` +`rplacd` changes the cdr portion of `cons` to `value`. It returns the +same `cons` it was given. ## `list` ``` @@ -32,16 +46,63 @@ a cons. (length list) ``` `length` returns the length of `list`, or nil if it is not a valid list. -If `list` is circular, `length` may never return. +**If `list` is circular, `length` will go into an infinite loop.** ## `nth` ``` (nth index list) ``` -Returns the `index`th element in `list`. `index` must be an int. +`nth` returns the `index`th element in `list`. `index` must be an int. + +If `index` is negative, `nth` will add `(length list)` to it. **This +will fail if `list` is circular.** ## `nthcdr` ``` (nthcdr index list) ``` -Returns the cdr of the `index`th cons in `list`. `index` must be an int. +`nthcdr` returns the cdr of the `index`th cons in `list`. `index` must +be an int. + +If `index` is negative, `nthcdr` will add `(length list)` to it. **This +will fail if `list` is circular.** + +## `append` +``` +(append &rest lists) +``` +`append` constructs a new list containing all the elements of `lists` +appended together. It makes a shallow copy of each of its arguments. + +## `push` +``` +(push list item) +``` +`push` pushes `item` onto `list` and returns the new head of `list`. + +## `assoc` +``` +(assoc alist key) +``` +`assoc` returns the first cons in `alist` whose car is +[`eq`](stdlib_comparison.md#eq) to `key`, or nil if no matching cons +was found. + +## `rassoc` +``` +(rassoc alist value) +``` +`rassoc` returns the first cons in `alist` whose cdr is +[`eq`](stdlib_comparison.md#eq) to `value`, or nil if no matching cons +was found. + +## `alist-put` +``` +(alist-put alist key value) +``` +`alist-put` creates a new cons mapping `key` to `value`, and attempts to +update `alist` with it in-place. If `alist` already contains a cons +whose car is [`eq`](stdlib_comparison.md#eq) to `key`, the cons is +replaced in-place with the new one. Otherwise, `alist-put` pushes the +new cons onto `alist` and returns the new head of `alist`, in the same +manner as [`push`](stdlib_data.md#push). diff --git a/lisp_types.h b/lisp_types.h index 4125d74..7c2e591 100644 --- a/lisp_types.h +++ b/lisp_types.h @@ -26,7 +26,7 @@ struct lisp_value { lisp_native_fun funptr; } value; char type; - bool gc; + //bool gc; } __attribute__((packed)); struct lisp_cons { diff --git a/native_funs.c b/native_funs.c index 6af2e5f..e9adab4 100644 --- a/native_funs.c +++ b/native_funs.c @@ -376,6 +376,18 @@ void lispf_cdr(lisp_cons* cons, lisp_value* value) { return; *value = cons->car.value.cons->cdr; } +void lispf_rplaca(lisp_cons* cons, lisp_value* value) { + if (cons->car.type != LISP_T_CONS || lisp_is_nil(cons->car)) + return; + cons->car.value.cons->car = cons->cdr.value.cons->car; + *value = cons->car; +} +void lispf_rplacd(lisp_cons* cons, lisp_value* value) { + if (cons->car.type != LISP_T_CONS || lisp_is_nil(cons->car)) + return; + cons->car.value.cons->cdr = cons->cdr.value.cons->car; + *value = cons->car; +} void lispf_list(lisp_cons* cons, lisp_value* value) { lisp_cons* head = NULL; @@ -416,11 +428,19 @@ void lispf_nth(lisp_cons* cons, lisp_value* value) { if (cons->car.type != LISP_T_INT) return; int index = cons->car.value._int; + if (index < 0) { + // index is negative, call lispf_length + lisp_value temp; + lispf_length(cons->cdr.value.cons, &temp); + index += temp.value._int; + } lisp_cons* head = cons->cdr.value.cons->car.value.cons; + if (head == NULL) + return; while (index > 0) { + head = head->cdr.value.cons; if (head == NULL) return; - head = head->cdr.value.cons; index--; } *value = head->car; @@ -429,14 +449,100 @@ void lispf_nthcdr(lisp_cons* cons, lisp_value* value) { if (cons->car.type != LISP_T_INT) return; int index = cons->car.value._int; + if (index < 0) { + // index is negative, call lispf_length + lisp_value temp; + lispf_length(cons->cdr.value.cons, &temp); + index += temp.value._int; + } lisp_cons* head = cons->cdr.value.cons->car.value.cons; + if (head == NULL) + return; while (index > 0) { + head = head->cdr.value.cons; if (head == NULL) return; - head = head->cdr.value.cons; index--; } - *value = head->cdr; + value->type = LISP_T_CONS; + value->value.cons = head; +} +void lispf_append(lisp_cons* cons, lisp_value* value) { + lisp_cons* head = NULL; + lisp_cons* tail = NULL; + + while (cons != NULL) { + if (cons->cdr.value.cons == NULL && cons->car.type != LISP_T_CONS) { + tail->cdr = cons->car; + break; + } else { + lisp_cons* subcons = cons->car.value.cons; + while (subcons != NULL) { + lisp_cons* element = dbg_malloc(sizeof(lisp_cons)); + element->car = subcons->car; + element->cdr.type = LISP_T_CONS; + element->cdr.value.cons = NULL; + + if (head == NULL) + head = element; + if (tail != NULL) + tail->cdr.value.cons = element; + + tail = element; + subcons = subcons->cdr.value.cons; + } + cons = cons->cdr.value.cons; + } + } + + value->type = LISP_T_CONS; + value->value.cons = head; +} +void lispf_push(lisp_cons* cons, lisp_value* value) { + lisp_cons* list = cons->car.value.cons; + lisp_value item = cons->cdr.value.cons->car; + + value->type = LISP_T_CONS; + value->value.cons = dbg_malloc(sizeof(lisp_cons)); + value->value.cons->car = item; + value->value.cons->cdr.type = LISP_T_CONS; + value->value.cons->cdr.value.cons = list; +} + +void lispf_assoc(lisp_cons* cons, lisp_value* value) { + lisp_cons* alist = cons->car.value.cons; + lisp_value key = cons->cdr.value.cons->car; + value->type = LISP_T_CONS; + value->value.cons = lisp_alist_get(alist, key); +} +void lispf_rassoc(lisp_cons* cons, lisp_value* value) { + lisp_cons* alist = cons->car.value.cons; + lisp_value cdr_key = cons->cdr.value.cons->car; + value->type = LISP_T_CONS; + while (alist != NULL) { + if (alist->car.type != LISP_T_CONS || alist->car.value.cons == NULL) + goto next; + value->value.cons = alist->car.value.cons; + if (lisp_is_equal(value->value.cons->cdr, cdr_key)) + return; + next: + if (alist->cdr.type == LISP_T_CONS) + alist = alist->cdr.value.cons; + else + alist = NULL; + } +} +void lispf_alist_put(lisp_cons* cons, lisp_value* value) { + value->type = LISP_T_CONS; + value->value.cons = cons->car.value.cons; + lisp_value key = cons->cdr.value.cons->car; + lisp_value new_value = cons->cdr.value.cons->cdr.value.cons->car; + + lisp_cons* pair = dbg_malloc(sizeof(lisp_cons)); + pair->car = key; + pair->cdr = new_value; + + lisp_cons* old_pair = lisp_alist_put(&value->value.cons, pair); } void lispf_type_of(lisp_cons* cons, lisp_value* value) { @@ -560,11 +666,19 @@ void init_native_funs() { lisp_defun_native(lisp_string_create("cons"), &lispf_cons); lisp_defun_native(lisp_string_create("car"), &lispf_car); lisp_defun_native(lisp_string_create("cdr"), &lispf_cdr); + lisp_defun_native(lisp_string_create("rplaca"), &lispf_rplaca); + lisp_defun_native(lisp_string_create("rplacd"), &lispf_rplacd); lisp_defun_native(lisp_string_create("list"), &lispf_list); lisp_defun_native(lisp_string_create("length"), &lispf_length); lisp_defun_native(lisp_string_create("nth"), &lispf_nth); lisp_defun_native(lisp_string_create("nthcdr"), &lispf_nthcdr); + lisp_defun_native(lisp_string_create("append"), &lispf_append); + lisp_defun_native(lisp_string_create("push"), &lispf_push); + + lisp_defun_native(lisp_string_create("assoc"), &lispf_assoc); + lisp_defun_native(lisp_string_create("rassoc"), &lispf_rassoc); + lisp_defun_native(lisp_string_create("alist-put"), &lispf_alist_put); // etc lisp_defun_native(lisp_string_create("type-of"), &lispf_type_of); diff --git a/native_funs.h b/native_funs.h index bcfa27f..151987e 100644 --- a/native_funs.h +++ b/native_funs.h @@ -28,11 +28,19 @@ void lispf_num_ge(lisp_cons* cons, lisp_value* value); void lispf_cons(lisp_cons* cons, lisp_value* value); void lispf_car(lisp_cons* cons, lisp_value* value); void lispf_cdr(lisp_cons* cons, lisp_value* value); +void lispf_rplaca(lisp_cons* cons, lisp_value* value); +void lispf_rplacd(lisp_cons* cons, lisp_value* value); void lispf_list(lisp_cons* cons, lisp_value* value); void lispf_length(lisp_cons* cons, lisp_value* value); void lispf_nth(lisp_cons* cons, lisp_value* value); void lispf_nthcdr(lisp_cons* cons, lisp_value* value); +void lispf_append(lisp_cons* cons, lisp_value* value); +void lispf_push(lisp_cons* cons, lisp_value* value); + +void lispf_assoc(lisp_cons* cons, lisp_value* value); +void lispf_rassoc(lisp_cons* cons, lisp_value* value); +void lispf_alist_put(lisp_cons* cons, lisp_value* value); void lispf_type_of(lisp_cons* cons, lisp_value* value); void lispf_addr_of(lisp_cons* cons, lisp_value* value);