2018-06-07 19:10:53 -04:00
|
|
|
#include <stdio.h>
|
|
|
|
#include <string.h>
|
|
|
|
#include <stdlib.h>
|
|
|
|
|
|
|
|
#include "expressions.h"
|
2018-06-10 11:58:29 -04:00
|
|
|
#include "environment.h"
|
2018-06-07 20:22:06 -04:00
|
|
|
#include "numbers.h"
|
2018-06-07 19:36:52 -04:00
|
|
|
#include "operations.h"
|
|
|
|
#include "error.h"
|
2018-06-07 19:10:53 -04:00
|
|
|
|
2018-06-07 20:06:57 -04:00
|
|
|
// Think about where to put these declarations later
|
|
|
|
lval* builtin(lval* a, char* func);
|
2018-06-07 19:10:53 -04:00
|
|
|
lval* builtin_op(lval* v, char* op);
|
|
|
|
|
|
|
|
lval* lval_sexpr(void) {
|
|
|
|
lval* v = (lval *) malloc(sizeof(lval));
|
|
|
|
v->type = LVAL_SEXPR;
|
|
|
|
v->count = 0;
|
|
|
|
v->cell = NULL;
|
|
|
|
return v;
|
|
|
|
}
|
|
|
|
lval* lval_qexpr(void) {
|
|
|
|
lval* v = (lval *) malloc(sizeof(lval));
|
|
|
|
v->type = LVAL_QEXPR;
|
|
|
|
v->count = 0;
|
|
|
|
v->cell = NULL;
|
|
|
|
return v;
|
|
|
|
}
|
|
|
|
|
|
|
|
lval* lval_add(lval* v, lval* x) {
|
|
|
|
v->count++;
|
|
|
|
v->cell = (lval **) realloc(v->cell, sizeof(lval*) * v->count);
|
|
|
|
v->cell[v->count - 1] = x;
|
|
|
|
return v;
|
|
|
|
}
|
|
|
|
|
|
|
|
lval* lval_pop(lval* v, int i) {
|
|
|
|
// Find the item at i
|
|
|
|
lval* x = v->cell[i];
|
|
|
|
|
|
|
|
// Shift the memory after the item i over the top
|
|
|
|
memmove(&v->cell[i], &v->cell[i + 1], sizeof(lval*) * (v->count - i - 1));
|
|
|
|
|
|
|
|
// Decrease the count of items in the list
|
|
|
|
v->count--;
|
|
|
|
|
|
|
|
// Reallocate the memory used
|
|
|
|
v->cell = (lval **) realloc(v->cell, sizeof(lval*) * v->count);
|
|
|
|
return x;
|
|
|
|
}
|
|
|
|
|
|
|
|
lval* lval_take(lval* v, int i) {
|
|
|
|
lval* x = lval_pop(v, i);
|
|
|
|
lval_del(v);
|
|
|
|
return x;
|
|
|
|
}
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* lval_eval_sexpr(lenv* e, lval* v) {
|
2018-06-09 22:47:19 -04:00
|
|
|
// No argument functions
|
2018-06-09 23:02:44 -04:00
|
|
|
if (v->count == 1 && v->cell[0]->type == LVAL_SYM) {
|
2018-06-17 11:10:57 -04:00
|
|
|
if (strcmp(v->cell[0]->data.sym, "exit") == 0) { return v; }
|
2018-06-09 22:47:19 -04:00
|
|
|
lval* x = lenv_get(e, v->cell[0]);
|
|
|
|
if (x->type == LVAL_FUN) {
|
|
|
|
lval_del(x);
|
2018-06-17 11:10:57 -04:00
|
|
|
if (strcmp(v->cell[0]->data.sym, "ls") == 0) {
|
2018-06-09 22:47:19 -04:00
|
|
|
lval_del(v);
|
|
|
|
return builtin_ls(e, lval_sexpr());
|
|
|
|
}
|
2018-06-09 23:26:27 -04:00
|
|
|
return v;
|
2018-06-09 22:47:19 -04:00
|
|
|
}
|
2018-06-09 23:26:27 -04:00
|
|
|
if (x->type == LVAL_ERR) { lval_del(v); return x; }
|
|
|
|
lval_del(x);
|
2018-06-09 22:47:19 -04:00
|
|
|
return v;
|
|
|
|
}
|
2018-06-07 19:10:53 -04:00
|
|
|
// Evaluate children
|
|
|
|
for (int i = 0; i < v->count; i++) {
|
2018-06-09 19:30:24 -04:00
|
|
|
v->cell[i] = lval_eval(e, v->cell[i]);
|
2018-06-07 19:10:53 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
// Error checking [If there's an error, return it]
|
|
|
|
for (int i = 0; i < v->count; i++) {
|
|
|
|
if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
|
|
|
|
}
|
|
|
|
|
|
|
|
// Empty expression
|
|
|
|
if (v->count == 0) { return v; }
|
|
|
|
|
|
|
|
// Single expression
|
2018-06-10 11:58:29 -04:00
|
|
|
if (v->count == 1) { return lval_eval(e, lval_take(v, 0)); }
|
2018-06-07 19:10:53 -04:00
|
|
|
|
|
|
|
// Ensure first element is a symbol otherwise
|
|
|
|
lval* f = lval_pop(v, 0);
|
2018-06-09 19:30:24 -04:00
|
|
|
if (f->type != LVAL_FUN) {
|
2018-06-10 11:58:29 -04:00
|
|
|
lval* err = lval_err(
|
|
|
|
"S-Experssion starts with incorrect type. "
|
|
|
|
"Got %s, Expected %s.",
|
|
|
|
ltype_name(f->type), ltype_name(LVAL_FUN));
|
2018-06-07 19:10:53 -04:00
|
|
|
lval_del(f); lval_del(v);
|
2018-06-10 11:58:29 -04:00
|
|
|
return err;
|
2018-06-07 19:10:53 -04:00
|
|
|
}
|
2018-06-09 19:30:24 -04:00
|
|
|
// If so call the function and return result
|
2018-06-10 11:58:29 -04:00
|
|
|
lval* result = lval_call(e, f, v);
|
2018-06-07 19:10:53 -04:00
|
|
|
lval_del(f);
|
|
|
|
return result;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_headn(lenv* e, lval* a, int n) {
|
2018-06-10 10:11:41 -04:00
|
|
|
LASSERT_NUM("head", a, 1)
|
|
|
|
LASSERT_TYPE("head", a, 0, LVAL_QEXPR)
|
|
|
|
LASSERT_NOT_EMPTY("head", a, 0)
|
2018-06-07 19:10:53 -04:00
|
|
|
|
2018-06-07 20:06:57 -04:00
|
|
|
lval* v = lval_take(a, 0);
|
2018-06-07 20:33:56 -04:00
|
|
|
while (v->count > n) { lval_del(lval_pop(v, v->count - 1)); }
|
2018-06-07 20:06:57 -04:00
|
|
|
return v;
|
|
|
|
}
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_head(lenv* e, lval* a) {
|
|
|
|
return builtin_headn(e, a, 1);
|
2018-06-07 20:33:56 -04:00
|
|
|
}
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_init(lenv* e, lval* a) {
|
2018-06-10 10:11:41 -04:00
|
|
|
LASSERT_NUM("init", a, 1)
|
|
|
|
LASSERT_TYPE("init", a, 0, LVAL_QEXPR)
|
|
|
|
LASSERT_NOT_EMPTY("init", a, 0)
|
2018-06-09 19:30:24 -04:00
|
|
|
return builtin_headn(e, a, a->cell[0]->count - 1);
|
2018-06-07 20:33:56 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_tail(lenv* e, lval* a) {
|
2018-06-10 10:11:41 -04:00
|
|
|
LASSERT_NUM("tail", a, 1)
|
|
|
|
LASSERT_TYPE("tail", a, 0, LVAL_QEXPR)
|
|
|
|
LASSERT_NOT_EMPTY("tail", a, 0)
|
2018-06-07 20:06:57 -04:00
|
|
|
|
|
|
|
lval* v = lval_take(a, 0);
|
|
|
|
lval_del(lval_pop(v, 0));
|
|
|
|
return v;
|
|
|
|
}
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_list(lenv* e, lval* a) {
|
2018-06-07 20:06:57 -04:00
|
|
|
a->type = LVAL_QEXPR;
|
|
|
|
return a;
|
|
|
|
}
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_eval(lenv* e, lval* a) {
|
2018-06-10 10:11:41 -04:00
|
|
|
LASSERT_NUM("eval", a, 1)
|
|
|
|
LASSERT_TYPE("eval", a, 0, LVAL_QEXPR)
|
2018-06-07 20:06:57 -04:00
|
|
|
|
|
|
|
lval* x = lval_take(a, 0);
|
|
|
|
x->type = LVAL_SEXPR;
|
2018-06-09 19:30:24 -04:00
|
|
|
return lval_eval(e, x);
|
2018-06-07 20:06:57 -04:00
|
|
|
}
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* lval_join(lenv* e, lval* x, lval* y) {
|
2018-06-07 20:06:57 -04:00
|
|
|
// For each cell in 'y' add it to 'x'
|
|
|
|
while (y->count) {
|
|
|
|
x = lval_add(x, lval_pop(y, 0));
|
|
|
|
}
|
|
|
|
|
|
|
|
// Delete the empty y and return x
|
|
|
|
lval_del(y);
|
|
|
|
return x;
|
|
|
|
}
|
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_join(lenv* e, lval* a) {
|
2018-06-07 20:06:57 -04:00
|
|
|
for (int i = 0 ; i < a->count; i++) {
|
2018-06-10 10:11:41 -04:00
|
|
|
LASSERT_TYPE("join", a, i, LVAL_QEXPR)
|
2018-06-07 20:06:57 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
lval* x = lval_pop(a, 0);
|
|
|
|
|
|
|
|
while (a->count) {
|
2018-06-09 19:30:24 -04:00
|
|
|
x = lval_join(e, x, lval_pop(a, 0));
|
2018-06-07 20:06:57 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
lval_del(a);
|
|
|
|
return x;
|
|
|
|
}
|
2018-06-07 20:22:06 -04:00
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_len(lenv* e, lval* a) {
|
2018-06-10 10:11:41 -04:00
|
|
|
LASSERT_TYPE("len", a, 0, LVAL_QEXPR)
|
2018-06-07 20:22:06 -04:00
|
|
|
lval* x = lval_long(a->cell[0]->count);
|
|
|
|
|
|
|
|
lval_del(a);
|
|
|
|
return x;
|
|
|
|
}
|
2018-06-09 10:16:03 -04:00
|
|
|
|
2018-06-09 19:30:24 -04:00
|
|
|
lval* builtin_cons(lenv* e, lval* a) {
|
2018-06-09 21:22:14 -04:00
|
|
|
LASSERT(a, a->cell[0]->type != LVAL_QEXPR, "Function 'cons' passed incorrect type on first argument. Got %s, expected not %s",
|
|
|
|
ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR))
|
2018-06-10 10:11:41 -04:00
|
|
|
LASSERT_TYPE("cons", a, 1, LVAL_QEXPR)
|
|
|
|
LASSERT_NUM("cons", a, 2)
|
2018-06-09 10:16:03 -04:00
|
|
|
|
|
|
|
lval* x = lval_qexpr();
|
|
|
|
x = lval_add(x, lval_pop(a, 0));
|
2018-06-09 19:30:24 -04:00
|
|
|
x = lval_join(e, x, lval_pop(a, 0));
|
2018-06-09 10:16:03 -04:00
|
|
|
|
|
|
|
lval_del(a);
|
|
|
|
|
|
|
|
return x;
|
|
|
|
|
|
|
|
}
|