108 lines
3.4 KiB
C
108 lines
3.4 KiB
C
#include "state.h"
|
|
#include "lisp.h"
|
|
#include "utility.h"
|
|
#include "internal.h"
|
|
|
|
#include <assert.h>
|
|
|
|
struct ucl_object *ucl_special_let(struct ucl_state *state, struct ucl_object *args) {
|
|
// TODO: Check arguments
|
|
struct ucl_object *assignments = ucl_car(args);
|
|
struct ucl_object *expressions = ucl_cdr(args);
|
|
struct ucl_state *let_state = ucl_state_create_child(state);
|
|
|
|
FOREACH_LIST(assignments, iter, item) {
|
|
// TODO: Check arguments
|
|
struct ucl_object *sym = ucl_car(item);
|
|
struct ucl_object *expr = ucl_car(ucl_cdr(item));
|
|
struct ucl_object *value = ucl_evaluate(let_state, expr);
|
|
|
|
assert(sym->type == UCL_TYPE_SYMBOL);
|
|
//assert(ucl_list_length(expr)->integer == 1);
|
|
|
|
if (value->type == UCL_TYPE_ERROR) {
|
|
// TODO cleanup
|
|
return value;
|
|
}
|
|
ucl_state_put(let_state, sym->symbol, value);
|
|
}
|
|
|
|
struct ucl_object *result = ucl_progn(let_state, expressions);
|
|
ucl_state_delete(let_state);
|
|
return result;
|
|
}
|
|
|
|
struct ucl_object *ucl_special_if(struct ucl_state *state, struct ucl_object *args) {
|
|
// TODO: Check arguments
|
|
struct ucl_object *cond = ucl_car(args);
|
|
struct ucl_object *true_form = ucl_list_nth(args, 1);
|
|
struct ucl_object *false_forms = ucl_cdr(ucl_cdr(args));
|
|
|
|
struct ucl_object *cond_result = ucl_evaluate(state, cond);
|
|
UCL_RET_IF_ERROR(cond_result);
|
|
if (ucl_truthy(cond_result)->type == UCL_TYPE_SYMBOL) {
|
|
return ucl_evaluate(state, true_form);
|
|
}
|
|
|
|
return ucl_progn(state, false_forms);
|
|
}
|
|
|
|
|
|
struct ucl_object *ucl_special_defun(struct ucl_state *state, struct ucl_object *args) {
|
|
// TODO: Check arguments
|
|
struct ucl_object *fun_sym = ucl_car(args);
|
|
if (fun_sym->type != UCL_TYPE_SYMBOL) {
|
|
return ucl_error_create("First argument to defun must be a symbol");
|
|
}
|
|
|
|
struct ucl_object *fun_args = ucl_list_nth(args, 1);
|
|
if (fun_args->type != UCL_TYPE_CELL) {
|
|
// TODO: Check that the list contains only symbols
|
|
return ucl_error_create("Second argument to defun must be a list of symbols");
|
|
}
|
|
|
|
// For now, other elements are just forms to be evaluated. Maybe one day
|
|
// there will be docstrings, maybe not!
|
|
|
|
// Functions are added to the root scope
|
|
ucl_state_put(ucl_state_get_root(state), fun_sym->symbol, ucl_cdr(args));
|
|
|
|
return fun_sym;
|
|
|
|
}
|
|
|
|
struct ucl_object *ucl_special_lambda(struct ucl_state *state, struct ucl_object *args) {
|
|
// TODO: Check arguments
|
|
struct ucl_object *fun_args = ucl_list_nth(args, 0);
|
|
if (fun_args->type != UCL_TYPE_CELL) {
|
|
// TODO: Check that the list contains only symbols
|
|
return ucl_error_create("First argument to lambda must be a list of symbols");
|
|
}
|
|
|
|
return args;
|
|
}
|
|
|
|
|
|
struct ucl_object *ucl_special_setq(struct ucl_state *state, struct ucl_object *args) {
|
|
// TODO: Check arguments
|
|
struct ucl_object *sym = ucl_car(args);
|
|
struct ucl_state *root_state = ucl_state_get_root(state);
|
|
if (sym->type != UCL_TYPE_SYMBOL) {
|
|
return ucl_error_create("First argument to setq must be a symbol");
|
|
}
|
|
|
|
struct ucl_object *value = ucl_evaluate(state, ucl_list_nth(args, 1));
|
|
|
|
ucl_state_put(root_state, sym->symbol, value);
|
|
|
|
return value;
|
|
}
|
|
|
|
struct ucl_object *ucl_special_progn(struct ucl_state *state, struct ucl_object *args) {
|
|
return ucl_progn(state, args);
|
|
}
|
|
|
|
struct ucl_object *ucl_special_quote(struct ucl_state *state, struct ucl_object *args) {
|
|
return ucl_car(args);
|
|
}
|