From 6c652b195c67062d4a196ff35a92720874dab9ed Mon Sep 17 00:00:00 2001 From: Max Regan Date: Wed, 2 Nov 2022 11:10:28 -0400 Subject: [PATCH] WIP: Hack in support for let binds --- src/builtins.c | 69 ++++++++++++++++++++++++++++++++++++++------------ src/builtins.h | 66 ++++++++++++++++++++++++----------------------- src/evaluate.c | 27 ++++++++++++++++++-- src/main.c | 2 ++ src/state.c | 17 +++++++++++-- src/state.h | 2 ++ src/uclisp.h | 3 ++- 7 files changed, 133 insertions(+), 53 deletions(-) diff --git a/src/builtins.c b/src/builtins.c index abb0010..0aaf52e 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -2,13 +2,14 @@ #include "internal.h" #include "utility.h" #include "builtins.h" +#include "state.h" #include #include #include #include -LISP_FUNC_1(ucl_builtin_type, arg) { +LISP_FUNC_1(ucl_builtin_type, state, arg) { switch (arg->type) { case UCL_TYPE_CELL: return ucl_symbol_create(strdup("list")); @@ -26,7 +27,7 @@ LISP_FUNC_1(ucl_builtin_type, arg) { } } -LISP_FUNC_1(ucl_builtin_error, arg) { +LISP_FUNC_1(ucl_builtin_error, state, arg) { if (arg->type != UCL_TYPE_STRING) { return ucl_error_create("Expected type string passed to 'error'"); } @@ -34,35 +35,35 @@ LISP_FUNC_1(ucl_builtin_error, arg) { return ucl_error_create(strdup(arg->error)); } -LISP_FUNC_1(ucl_builtin_symbol_p, arg) { +LISP_FUNC_1(ucl_builtin_symbol_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_SYMBOL); } -LISP_FUNC_1(ucl_builtin_string_p, arg) { +LISP_FUNC_1(ucl_builtin_string_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_STRING); } -LISP_FUNC_1(ucl_builtin_int_p, arg) { +LISP_FUNC_1(ucl_builtin_int_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_INT); } -LISP_FUNC_1(ucl_builtin_list_p, arg) { +LISP_FUNC_1(ucl_builtin_list_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_CELL); } -LISP_FUNC_1(ucl_builtin_error_p, arg) { +LISP_FUNC_1(ucl_builtin_error_p, state, arg) { return ucl_predicate(arg->type == UCL_TYPE_ERROR); } -LISP_FUNC_1(ucl_builtin_car, arg) { +LISP_FUNC_1(ucl_builtin_car, state, arg) { return ucl_car(arg); } -LISP_FUNC_1(ucl_builtin_cdr, arg) { +LISP_FUNC_1(ucl_builtin_cdr, state, arg) { return ucl_cdr(arg); } -LISP_FUNC_2(ucl_builtin_add, arg0, arg1) { +LISP_FUNC_2(ucl_builtin_add, state, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'add'"); } @@ -74,7 +75,7 @@ LISP_FUNC_2(ucl_builtin_add, arg0, arg1) { return ucl_int_create(arg0->integer + arg1->integer); } -LISP_FUNC_2(ucl_builtin_sub, arg0, arg1) { +LISP_FUNC_2(ucl_builtin_sub, state, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'sub'"); } @@ -86,7 +87,7 @@ LISP_FUNC_2(ucl_builtin_sub, arg0, arg1) { return ucl_int_create(arg0->integer - arg1->integer); } -LISP_FUNC_2(ucl_builtin_mul, arg0, arg1) { +LISP_FUNC_2(ucl_builtin_mul, state, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'mul'"); } @@ -98,7 +99,7 @@ LISP_FUNC_2(ucl_builtin_mul, arg0, arg1) { return ucl_int_create(arg0->integer * arg1->integer); } -LISP_FUNC_2(ucl_builtin_div, arg0, arg1) { +LISP_FUNC_2(ucl_builtin_div, state, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'div'"); } @@ -110,7 +111,7 @@ LISP_FUNC_2(ucl_builtin_div, arg0, arg1) { return ucl_int_create(arg0->integer / arg1->integer); } -LISP_FUNC_2(ucl_builtin_mod, arg0, arg1) { +LISP_FUNC_2(ucl_builtin_mod, state, arg0, arg1) { if (arg0->type != UCL_TYPE_INT) { return ucl_error_create("Invalid type of argument 0 to 'mod'"); } @@ -122,7 +123,7 @@ LISP_FUNC_2(ucl_builtin_mod, arg0, arg1) { return ucl_int_create(arg0->integer % arg1->integer); } -LISP_FUNC_2(ucl_builtin_concat, arg0, arg1) { +LISP_FUNC_2(ucl_builtin_concat, state, arg0, arg1) { if (arg0->type != UCL_TYPE_STRING) { return ucl_error_create("Invalid type of argument 0 to 'concat'"); } @@ -140,7 +141,43 @@ LISP_FUNC_2(ucl_builtin_concat, arg0, arg1) { return ucl_string_create(outstr); } -LISP_FUNC_0(ucl_builtin_now_millis_mono) { +LISP_FUNC_0(ucl_builtin_now_millis_mono, state) { // TODO: Implement and move to a 'platform' file return NULL; } + +struct ucl_object *ucl_builtin_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 + assert(0); + } + ucl_state_put(let_state, sym->symbol, value); + } + + struct ucl_object *result = NULL; + FOREACH_LIST(expressions, iter, item) { + result = ucl_evaluate(let_state, item); + if (result->type == UCL_TYPE_ERROR) { + assert(0); + break; + } + } + + + ucl_state_delete(let_state); + return result; +} diff --git a/src/builtins.h b/src/builtins.h index a1e8908..800539b 100644 --- a/src/builtins.h +++ b/src/builtins.h @@ -3,19 +3,19 @@ #include "utility.h" -#define LISP_FUNC_0(func_name) \ - static struct ucl_object *func_name##_impl(); \ - struct ucl_object *func_name(struct ucl_object *args) { \ - if (args->cell.car != NULL) { \ - return NULL; \ - } \ - return func_name##_impl(); \ - } \ - static struct ucl_object *func_name##_impl() +#define LISP_FUNC_0(func_name, state_name) \ + static struct ucl_object *func_name##_impl(); \ + struct ucl_object *func_name(struct ucl_state *state, struct ucl_object *args) { \ + if (args->cell.car != NULL) { \ + return NULL; \ + } \ + return func_name##_impl(state_name); \ + } \ + static struct ucl_object *func_name##_impl(struct ucl_state *state) -#define LISP_FUNC_1(func_name, arg0_name) \ - static struct ucl_object *func_name##_impl(struct ucl_object *arg0_name); \ - struct ucl_object *func_name(struct ucl_object *args) { \ +#define LISP_FUNC_1(func_name, state_name, arg0_name) \ + static struct ucl_object *func_name##_impl(struct ucl_state *state, struct ucl_object *arg0_name); \ + struct ucl_object *func_name(struct ucl_state *state, struct ucl_object *args) { \ struct ucl_object *len_obj = ucl_list_length(args); \ if (len_obj->type != UCL_TYPE_INT) { \ return NULL; \ @@ -24,14 +24,14 @@ return NULL; \ } \ struct ucl_object *arg0 = ucl_car(args); \ - return func_name##_impl(arg0); \ + return func_name##_impl(state_name, arg0); \ } \ - static struct ucl_object *func_name##_impl(struct ucl_object *arg0_name) + static struct ucl_object *func_name##_impl(struct ucl_state *state, struct ucl_object *arg0_name) // TODO: Unroll the args more efficiently, this is O(n^2) -#define LISP_FUNC_2(func_name, arg0_name, arg1_name) \ - static struct ucl_object *func_name##_impl(struct ucl_object *arg0_name, struct ucl_object *arg1_name); \ - struct ucl_object *func_name(struct ucl_object *args) { \ +#define LISP_FUNC_2(func_name, state_name, arg0_name, arg1_name) \ + static struct ucl_object *func_name##_impl(struct ucl_state *state, struct ucl_object *arg0_name, struct ucl_object *arg1_name); \ + struct ucl_object *func_name(struct ucl_state *state, struct ucl_object *args) { \ struct ucl_object *len_obj = ucl_list_length(args); \ if (len_obj->type != UCL_TYPE_INT) { \ return NULL; \ @@ -41,25 +41,27 @@ } \ struct ucl_object *arg0 = ucl_list_nth(args, 0); \ struct ucl_object *arg1 = ucl_list_nth(args, 1); \ - return func_name##_impl(arg0, arg1); \ + return func_name##_impl(state_name, arg0, arg1); \ } \ - static struct ucl_object *func_name##_impl(struct ucl_object *arg0_name, struct ucl_object *arg1_name) + static struct ucl_object *func_name##_impl(struct ucl_state *state, struct ucl_object *arg0_name, struct ucl_object *arg1_name) -struct ucl_object *ucl_builtin_error(struct ucl_object *args); -struct ucl_object *ucl_builtin_type(struct ucl_object *args); -struct ucl_object *ucl_builtin_symbol_p(struct ucl_object *args); -struct ucl_object *ucl_builtin_string_p(struct ucl_object *args); -struct ucl_object *ucl_builtin_int_p(struct ucl_object *args); -struct ucl_object *ucl_builtin_list_p(struct ucl_object *args); +struct ucl_object *ucl_builtin_error(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_type(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_symbol_p(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_string_p(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_int_p(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_list_p(struct ucl_state *state, struct ucl_object *args); -struct ucl_object *ucl_builtin_add(struct ucl_object *args); -struct ucl_object *ucl_builtin_sub(struct ucl_object *args); -struct ucl_object *ucl_builtin_mul(struct ucl_object *args); -struct ucl_object *ucl_builtin_div(struct ucl_object *args); -struct ucl_object *ucl_builtin_mod(struct ucl_object *args); -struct ucl_object *ucl_builtin_concat(struct ucl_object *args); +struct ucl_object *ucl_builtin_add(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_sub(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_mul(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_div(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_mod(struct ucl_state *state, struct ucl_object *args); +struct ucl_object *ucl_builtin_concat(struct ucl_state *state, struct ucl_object *args); -struct ucl_object *ucl_builtin_now_millis_mono(struct ucl_object *args); +struct ucl_object *ucl_builtin_now_millis_mono(struct ucl_state *state, struct ucl_object *args); + +struct ucl_object *ucl_builtin_let(struct ucl_state *state, struct ucl_object *args); #endif diff --git a/src/evaluate.c b/src/evaluate.c index 746a66c..da0dbb7 100644 --- a/src/evaluate.c +++ b/src/evaluate.c @@ -6,6 +6,8 @@ #include "utility.h" #include "state.h" +#include + struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object *list) { // TODO: Recursively eval args struct ucl_object *evaluated_list = ucl_nil_create(); @@ -21,7 +23,7 @@ struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object assert(fun->type == UCL_TYPE_BUILTIN); if (fun->type == UCL_TYPE_BUILTIN) { - result = fun->builtin(args); + result = fun->builtin(state, args); } // TODO: Non-builtins @@ -31,12 +33,33 @@ struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object return result; } +struct ucl_object *ucl_evaluate_special_form(struct ucl_state *state, struct ucl_object *list) { + // TODO: Recursively eval args + const char *fun_sym = ucl_car(list)->symbol; + + if (strcmp(fun_sym, "let")) { + return ucl_evaluate_list(state, list); + } + + struct ucl_object *fun = ucl_state_get(state, ucl_car(list)->symbol); + struct ucl_object *args = ucl_cdr(list); + struct ucl_object *result = NULL; + + assert(fun->type == UCL_TYPE_BUILTIN); + if (fun->type == UCL_TYPE_BUILTIN) { + // TODO: check for errors + result = fun->builtin(state, args); + } + + return result; +} + struct ucl_object *ucl_evaluate(struct ucl_state *state, struct ucl_object *obj) { assert(obj != NULL); switch (obj->type) { case UCL_TYPE_CELL: - return ucl_evaluate_list(state, obj); + return ucl_evaluate_special_form(state, obj); case UCL_TYPE_SYMBOL: return ucl_state_get(state, obj->symbol); case UCL_TYPE_INT: diff --git a/src/main.c b/src/main.c index ad3c32b..fb1bbdb 100644 --- a/src/main.c +++ b/src/main.c @@ -11,6 +11,8 @@ int main(int argc, const char **argv) { (void) argc, (void) argv; struct ucl_state *state = ucl_state_create(); + ucl_state_put(state, "let", ucl_builtin_create(ucl_builtin_let)); + ucl_state_put(state, "+", ucl_builtin_create(ucl_builtin_add)); ucl_state_put(state, "-", ucl_builtin_create(ucl_builtin_sub)); ucl_state_put(state, "*", ucl_builtin_create(ucl_builtin_mul)); diff --git a/src/state.c b/src/state.c index bf6149c..f172676 100644 --- a/src/state.c +++ b/src/state.c @@ -12,12 +12,12 @@ struct ucl_state { struct ucl_object *list; + struct ucl_state *parent; }; #define NAME_POSITION 0 #define DATA_POSITION 1 - static struct ucl_object *ucl_state_get_cell(struct ucl_state *state, const char *name) { FOREACH_LIST(state->list, iter, item) { assert(item->type == UCL_TYPE_CELL); @@ -32,7 +32,13 @@ static struct ucl_object *ucl_state_get_cell(struct ucl_state *state, const char struct ucl_object *ucl_state_get(struct ucl_state *state, const char *name) { struct ucl_object *cell = ucl_state_get_cell(state, name); - UCL_COND_OR_RET_ERROR(cell != NULL, "Unknown name"); + if (cell == NULL) { + if (state->parent == NULL) { + return ucl_error_create(strdup("Unknown error")); + } else { + return ucl_state_get(state->parent, name); + } + } return ucl_list_nth(cell, DATA_POSITION); } @@ -52,6 +58,13 @@ void ucl_state_put(struct ucl_state *state, const char *name, struct ucl_object struct ucl_state *ucl_state_create() { struct ucl_state *state = malloc(sizeof(struct ucl_state)); state->list = ucl_nil_create(); + state->parent = NULL; + return state; +} + +struct ucl_state *ucl_state_create_child(struct ucl_state *parent) { + struct ucl_state *state = ucl_state_create(); + state->parent = parent; return state; } diff --git a/src/state.h b/src/state.h index 3b8ed3f..1328c5c 100644 --- a/src/state.h +++ b/src/state.h @@ -4,6 +4,8 @@ struct ucl_state; struct ucl_state *ucl_state_create(); +struct ucl_state *ucl_state_create_child(struct ucl_state *parent); + void ucl_state_delete(struct ucl_state *state); struct ucl_object *ucl_state_get(struct ucl_state *state, const char *name); diff --git a/src/uclisp.h b/src/uclisp.h index f28a9b9..8143ffc 100644 --- a/src/uclisp.h +++ b/src/uclisp.h @@ -16,7 +16,8 @@ struct ucl_cell { struct ucl_object *cdr; }; -typedef struct ucl_object *(*ucl_builtin)(struct ucl_object *args); +struct ucl_state; +typedef struct ucl_object *(*ucl_builtin)(struct ucl_state* state, struct ucl_object *args); struct ucl_object { enum ucl_type type;