#include "native_funs.h" void lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_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 lisp_type_of(lisp_cons* cons, lisp_value* value) { if (lisp_is_nil(cons->car)) { value->type = LISP_T_CONS; value->value.cons = NULL; 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 lisp_addr_of(lisp_cons* cons, lisp_value* value) { value->type = LISP_T_INT; value->value._int = (long) cons->car.value.cons; } void init_native_funs() { // arithmetic lisp_defun_native(lisp_string_create("+"), &lisp_add); lisp_defun_native(lisp_string_create("-"), &lisp_sub); lisp_defun_native(lisp_string_create("*"), &lisp_mul); lisp_defun_native(lisp_string_create("/"), &lisp_div); lisp_defun_native(lisp_string_create("int/"), &lisp_intdiv); // boolean logic lisp_defun_native(lisp_string_create("not"), &lisp_not); lisp_defun_native(lisp_string_create("or"), &lisp_or); lisp_defun_native(lisp_string_create("and"), &lisp_and); // comparison lisp_defun_native(lisp_string_create("eq"), &lisp_eq); lisp_defun_native(lisp_string_create("="), &lisp_num_eq); lisp_defun_native(lisp_string_create("<"), &lisp_num_lt); lisp_defun_native(lisp_string_create(">"), &lisp_num_gt); lisp_defun_native(lisp_string_create("<="), &lisp_num_le); lisp_defun_native(lisp_string_create(">="), &lisp_num_ge); // etc lisp_defun_native(lisp_string_create("type-of"), &lisp_type_of); lisp_defun_native(lisp_string_create("addr-of"), &lisp_addr_of); }