#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(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);
}