702 lines
19 KiB
C
702 lines
19 KiB
C
#include "native_funs.h"
|
|
|
|
void lispf_add(lisp_cons* cons, lisp_value* value) {
|
|
long _int = 0;
|
|
float _float = 0.0f;
|
|
bool is_float = false;
|
|
while (cons != NULL) {
|
|
if (!is_float) {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_int += cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT) {
|
|
_float = (float) _int;
|
|
is_float = true;
|
|
_float += cons->car.value._float;
|
|
}
|
|
} else {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_float += cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT)
|
|
_float += cons->car.value._float;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
if (is_float) {
|
|
value->type = LISP_T_FLOAT;
|
|
value->value._float = _float;
|
|
} else {
|
|
value->type = LISP_T_INT;
|
|
value->value._int = _int;
|
|
}
|
|
}
|
|
void lispf_sub(lisp_cons* cons, lisp_value* value) {
|
|
long _int = 0;
|
|
float _float = 0.0f;
|
|
bool is_float = false;
|
|
|
|
if (cons->car.type == LISP_T_FLOAT) {
|
|
_float = cons->car.value._float;
|
|
is_float = true;
|
|
} else if (cons->car.type == LISP_T_INT) {
|
|
_int = cons->car.value._int;
|
|
} else {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
|
|
if (cons->cdr.value.cons == NULL) {
|
|
if (is_float) {
|
|
value->type = LISP_T_FLOAT;
|
|
value->value._float = -_float;
|
|
} else {
|
|
value->type = LISP_T_INT;
|
|
value->value._int = -_int;
|
|
}
|
|
return;
|
|
} else
|
|
cons = cons->cdr.value.cons;
|
|
|
|
while (cons != NULL) {
|
|
if (!is_float) {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_int -= cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT) {
|
|
_float = (float) _int;
|
|
is_float = true;
|
|
_float -= cons->car.value._float;
|
|
}
|
|
} else {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_float -= cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT)
|
|
_float -= cons->car.value._float;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
if (is_float) {
|
|
value->type = LISP_T_FLOAT;
|
|
value->value._float = _float;
|
|
} else {
|
|
value->type = LISP_T_INT;
|
|
value->value._int = _int;
|
|
}
|
|
}
|
|
void lispf_mul(lisp_cons* cons, lisp_value* value) {
|
|
long _int = 1;
|
|
float _float = 1;
|
|
bool is_float = false;
|
|
while (cons != NULL) {
|
|
if (!is_float) {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_int *= cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT) {
|
|
_float = (float) _int;
|
|
is_float = true;
|
|
_float *= cons->car.value._float;
|
|
}
|
|
} else {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_float *= cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT)
|
|
_float *= cons->car.value._float;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
if (is_float) {
|
|
value->type = LISP_T_FLOAT;
|
|
value->value._float = _float;
|
|
} else {
|
|
value->type = LISP_T_INT;
|
|
value->value._int = _int;
|
|
}
|
|
}
|
|
void lispf_div(lisp_cons* cons, lisp_value* value) {
|
|
float _float = 0;
|
|
|
|
if (cons->car.type == LISP_T_FLOAT)
|
|
_float = cons->car.value._float;
|
|
else if (cons->car.type == LISP_T_INT)
|
|
_float = cons->car.value._int;
|
|
else {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_float /= cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT)
|
|
_float /= cons->car.value._float;
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
value->type = LISP_T_FLOAT;
|
|
value->value._float = _float;
|
|
}
|
|
void lispf_intdiv(lisp_cons* cons, lisp_value* value) {
|
|
long _int = 0;
|
|
|
|
if (cons->car.type == LISP_T_FLOAT)
|
|
_int = cons->car.value._float;
|
|
else if (cons->car.type == LISP_T_INT)
|
|
_int = cons->car.value._int;
|
|
else {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
if (cons->car.type == LISP_T_INT)
|
|
_int /= cons->car.value._int;
|
|
else if (cons->car.type == LISP_T_FLOAT)
|
|
_int /= cons->car.value._float;
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
value->type = LISP_T_INT;
|
|
value->value._int = _int;
|
|
}
|
|
|
|
void lispf_not(lisp_cons* cons, lisp_value* value) {
|
|
if (lisp_is_nil(cons->car)) {
|
|
value->type = LISP_T_ATOM;
|
|
value->value.atom = atom_t;
|
|
} else {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
}
|
|
}
|
|
void lispf_or(lisp_cons* cons, lisp_value* value) {
|
|
while (cons != NULL) {
|
|
if (!lisp_is_nil(cons->car)) {
|
|
*value = cons->car;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
}
|
|
void lispf_and(lisp_cons* cons, lisp_value* value) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
while (cons != NULL) {
|
|
*value = cons->car;
|
|
if (lisp_is_nil(cons->car))
|
|
return;
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
}
|
|
|
|
void lispf_eq(lisp_cons* cons, lisp_value* value) {
|
|
lisp_value cmp_value = cons->car;
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
if (!lisp_is_equal(cmp_value, cons->car)) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
value->type = LISP_T_ATOM;
|
|
value->value.atom = atom_t;
|
|
}
|
|
void lispf_num_eq(lisp_cons* cons, lisp_value* value) {
|
|
lisp_value cmp_value = cons->car;
|
|
if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
bool cmp = false;
|
|
if (cons->car.type == LISP_T_INT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int == cons->car.value._int);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float == cons->car.value._int);
|
|
} else if (cons->car.type == LISP_T_FLOAT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int == cons->car.value._float);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float == cons->car.value._float);
|
|
}
|
|
if (!cmp) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
*value = cmp_value;
|
|
}
|
|
void lispf_num_lt(lisp_cons* cons, lisp_value* value) {
|
|
lisp_value cmp_value = cons->car;
|
|
if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
bool cmp = false;
|
|
if (cons->car.type == LISP_T_INT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int < cons->car.value._int);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float < cons->car.value._int);
|
|
} else if (cons->car.type == LISP_T_FLOAT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int < cons->car.value._float);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float < cons->car.value._float);
|
|
}
|
|
if (!cmp) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cmp_value = cons->car;
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
*value = cmp_value;
|
|
}
|
|
void lispf_num_gt(lisp_cons* cons, lisp_value* value) {
|
|
lisp_value cmp_value = cons->car;
|
|
if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
bool cmp = false;
|
|
if (cons->car.type == LISP_T_INT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int > cons->car.value._int);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float > cons->car.value._int);
|
|
} else if (cons->car.type == LISP_T_FLOAT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int > cons->car.value._float);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float > cons->car.value._float);
|
|
}
|
|
if (!cmp) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cmp_value = cons->car;
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
*value = cmp_value;
|
|
}
|
|
void lispf_num_le(lisp_cons* cons, lisp_value* value) {
|
|
lisp_value cmp_value = cons->car;
|
|
if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
bool cmp = false;
|
|
if (cons->car.type == LISP_T_INT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int <= cons->car.value._int);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float <= cons->car.value._int);
|
|
} else if (cons->car.type == LISP_T_FLOAT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int <= cons->car.value._float);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float <= cons->car.value._float);
|
|
}
|
|
if (!cmp) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cmp_value = cons->car;
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
*value = cmp_value;
|
|
}
|
|
void lispf_num_ge(lisp_cons* cons, lisp_value* value) {
|
|
lisp_value cmp_value = cons->car;
|
|
if (cmp_value.type != LISP_T_INT && cmp_value.type != LISP_T_FLOAT) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cons = cons->cdr.value.cons;
|
|
while (cons != NULL) {
|
|
bool cmp = false;
|
|
if (cons->car.type == LISP_T_INT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int >= cons->car.value._int);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float >= cons->car.value._int);
|
|
} else if (cons->car.type == LISP_T_FLOAT) {
|
|
if (cmp_value.type == LISP_T_INT)
|
|
cmp = (cmp_value.value._int >= cons->car.value._float);
|
|
else if (cmp_value.type == LISP_T_FLOAT)
|
|
cmp = (cmp_value.value._float >= cons->car.value._float);
|
|
}
|
|
if (!cmp) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = NULL;
|
|
return;
|
|
}
|
|
cmp_value = cons->car;
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
*value = cmp_value;
|
|
}
|
|
|
|
void lispf_cons(lisp_cons* cons, lisp_value* value) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = dbg_malloc(sizeof(lisp_cons));
|
|
value->value.cons->car = cons->car;
|
|
value->value.cons->cdr = cons->cdr.value.cons->car;
|
|
}
|
|
void lispf_car(lisp_cons* cons, lisp_value* value) {
|
|
if (cons->car.type != LISP_T_CONS || lisp_is_nil(cons->car))
|
|
return;
|
|
*value = cons->car.value.cons->car;
|
|
}
|
|
void lispf_cdr(lisp_cons* cons, lisp_value* value) {
|
|
if (cons->car.type != LISP_T_CONS || lisp_is_nil(cons->car))
|
|
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;
|
|
lisp_cons* tail = NULL;
|
|
while (cons != NULL) {
|
|
lisp_cons* element = dbg_malloc(sizeof(lisp_cons));
|
|
element->car = cons->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;
|
|
|
|
cons = cons->cdr.value.cons;
|
|
}
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = head;
|
|
}
|
|
void lispf_length(lisp_cons* cons, lisp_value* value) {
|
|
if (cons->car.type != LISP_T_CONS)
|
|
return;
|
|
lisp_cons* head = cons->car.value.cons;
|
|
value->type = LISP_T_INT;
|
|
value->value._int = 0;
|
|
while (head != NULL) {
|
|
value->value._int++;
|
|
if (head->cdr.type != LISP_T_CONS)
|
|
head = NULL;
|
|
else
|
|
head = head->cdr.value.cons;
|
|
}
|
|
}
|
|
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;
|
|
index--;
|
|
}
|
|
*value = head->car;
|
|
}
|
|
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;
|
|
index--;
|
|
}
|
|
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) {
|
|
if (lisp_is_nil(cons->car)) {
|
|
return;
|
|
}
|
|
value->type = LISP_T_ATOM;
|
|
switch (cons->car.type) {
|
|
case LISP_T_CONS:
|
|
value->value.atom = atom_cons;
|
|
break;
|
|
case LISP_T_ATOM:
|
|
value->value.atom = atom_atom;
|
|
break;
|
|
case LISP_T_INT:
|
|
value->value.atom = atom_int;
|
|
break;
|
|
case LISP_T_FLOAT:
|
|
value->value.atom = atom_float;
|
|
break;
|
|
case LISP_T_STRING:
|
|
value->value.atom = atom_string;
|
|
break;
|
|
case LISP_T_FUNPTR:
|
|
value->value.atom = atom_native_fun;
|
|
break;
|
|
}
|
|
}
|
|
|
|
void lispf_addr_of(lisp_cons* cons, lisp_value* value) {
|
|
value->type = LISP_T_INT;
|
|
value->value._int = (long) cons->car.value.cons;
|
|
}
|
|
|
|
void lispf_set(lisp_cons* cons, lisp_value* value) {
|
|
// extract key and value
|
|
lisp_value key = cons->car;
|
|
*value = cons->cdr.value.cons->car;
|
|
lisp_cons** pairptr = lisp_alist_getptr(syms_alist, key);
|
|
if (pairptr != NULL) {
|
|
// just overwrite cdr, don't make a new pair
|
|
(*pairptr)->cdr = *value;
|
|
return;
|
|
}
|
|
// create cons pair for new var
|
|
lisp_cons* pair = dbg_malloc(sizeof(lisp_cons));
|
|
pair->car = key;
|
|
pair->cdr = *value;
|
|
// add to alist
|
|
lisp_cons* new_alist = dbg_malloc(sizeof(lisp_cons));
|
|
new_alist->car.type = LISP_T_CONS;
|
|
new_alist->car.value.cons = pair;
|
|
new_alist->cdr.type = LISP_T_CONS;
|
|
new_alist->cdr.value.cons = syms_alist;
|
|
syms_alist = new_alist;
|
|
}
|
|
|
|
void lispf_unset(lisp_cons* cons, lisp_value* value) {
|
|
lisp_cons* pair = lisp_alist_del(&syms_alist, cons->car);
|
|
if (pair == NULL)
|
|
return;
|
|
*value = pair->cdr;
|
|
dbg_free(pair);
|
|
}
|
|
|
|
void lispf_fun(lisp_cons* cons, lisp_value* value) {
|
|
lisp_cons* pair = lisp_alist_get(funs_alist, cons->car);
|
|
if (pair == NULL)
|
|
return;
|
|
*value = pair->cdr;
|
|
}
|
|
|
|
void lispf_print(lisp_cons* cons, lisp_value* value) {
|
|
while (cons != NULL) {
|
|
if (cons->car.type == LISP_T_STRING)
|
|
lisp_string_print(cons->car.value.string);
|
|
else
|
|
print_value(cons->car);
|
|
cons = cons->cdr.value.cons;
|
|
if (cons != NULL)
|
|
printf(" ");
|
|
}
|
|
printf("\n");
|
|
}
|
|
|
|
void lispf_internals_syms_alist(lisp_cons* cons, lisp_value* value) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = syms_alist;
|
|
}
|
|
void lispf_internals_funs_alist(lisp_cons* cons, lisp_value* value) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = funs_alist;
|
|
}
|
|
void lispf_internals_atoms_alist(lisp_cons* cons, lisp_value* value) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = atoms_alist;
|
|
}
|
|
|
|
void lispf_internals_fun_set(lisp_cons* cons, lisp_value* value) {
|
|
value->type = LISP_T_CONS;
|
|
value->value.cons = lisp_defun_lisp_fun(cons->car.value.atom, cons->cdr.value.cons->car.value.cons);
|
|
}
|
|
|
|
void init_native_funs() {
|
|
// arithmetic
|
|
lisp_defun_native(lisp_string_create("+"), &lispf_add);
|
|
lisp_defun_native(lisp_string_create("-"), &lispf_sub);
|
|
lisp_defun_native(lisp_string_create("*"), &lispf_mul);
|
|
lisp_defun_native(lisp_string_create("/"), &lispf_div);
|
|
lisp_defun_native(lisp_string_create("int/"), &lispf_intdiv);
|
|
|
|
// boolean logic
|
|
lisp_defun_native(lisp_string_create("not"), &lispf_not);
|
|
lisp_defun_native(lisp_string_create("or"), &lispf_or);
|
|
lisp_defun_native(lisp_string_create("and"), &lispf_and);
|
|
|
|
// comparison
|
|
lisp_defun_native(lisp_string_create("eq"), &lispf_eq);
|
|
lisp_defun_native(lisp_string_create("="), &lispf_num_eq);
|
|
lisp_defun_native(lisp_string_create("<"), &lispf_num_lt);
|
|
lisp_defun_native(lisp_string_create(">"), &lispf_num_gt);
|
|
lisp_defun_native(lisp_string_create("<="), &lispf_num_le);
|
|
lisp_defun_native(lisp_string_create(">="), &lispf_num_ge);
|
|
|
|
// data structures
|
|
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);
|
|
lisp_defun_native(lisp_string_create("addr-of"), &lispf_addr_of);
|
|
lisp_defun_native(lisp_string_create("set"), &lispf_set);
|
|
lisp_defun_native(lisp_string_create("unset!"), &lispf_unset);
|
|
lisp_defun_native(lisp_string_create("fun"), &lispf_fun);
|
|
lisp_defun_native(lisp_string_create("print"), &lispf_print);
|
|
|
|
// internals
|
|
lisp_defun_native(lisp_string_create("syms-alist!"), &lispf_internals_syms_alist);
|
|
lisp_defun_native(lisp_string_create("funs-alist!"), &lispf_internals_funs_alist);
|
|
lisp_defun_native(lisp_string_create("atoms-alist!"), &lispf_internals_atoms_alist);
|
|
lisp_defun_native(lisp_string_create("fun-set!"), &lispf_internals_fun_set);
|
|
}
|