max/uclisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

WIP: Hack in support for let binds

Browse Source
This commit is contained in:
Max Regan
2022-11-02 11:10:28 -04:00
parent 5dbe3c67af
commit 6c652b195c
7 changed files with 133 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
src/builtins.c
View File

@@ -2,13 +2,14 @@
#include "internal.h" #include "internal.h"
#include "utility.h" #include "utility.h"
#include "builtins.h" #include "builtins.h"
#include "state.h"
#include <assert.h> #include <assert.h>
#include <stddef.h> #include <stddef.h>
#include <string.h> #include <string.h>
#include <stdlib.h> #include <stdlib.h>
LISP_FUNC_1(ucl_builtin_type, arg) { LISP_FUNC_1(ucl_builtin_type, state, arg) {
switch (arg->type) { switch (arg->type) {
case UCL_TYPE_CELL: case UCL_TYPE_CELL:
return ucl_symbol_create(strdup("list")); 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) { if (arg->type != UCL_TYPE_STRING) {
return ucl_error_create("Expected type string passed to 'error'"); 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)); 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); 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); 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); 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); 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); 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); return ucl_car(arg);
} }
LISP_FUNC_1(ucl_builtin_cdr, arg) { LISP_FUNC_1(ucl_builtin_cdr, state, arg) {
return ucl_cdr(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) { if (arg0->type != UCL_TYPE_INT) {
return ucl_error_create("Invalid type of argument 0 to 'add'"); 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); 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) { if (arg0->type != UCL_TYPE_INT) {
return ucl_error_create("Invalid type of argument 0 to 'sub'"); 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); 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) { if (arg0->type != UCL_TYPE_INT) {
return ucl_error_create("Invalid type of argument 0 to 'mul'"); 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); 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) { if (arg0->type != UCL_TYPE_INT) {
return ucl_error_create("Invalid type of argument 0 to 'div'"); 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); 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) { if (arg0->type != UCL_TYPE_INT) {
return ucl_error_create("Invalid type of argument 0 to 'mod'"); 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); 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) { if (arg0->type != UCL_TYPE_STRING) {
return ucl_error_create("Invalid type of argument 0 to 'concat'"); 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); 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 // TODO: Implement and move to a 'platform' file
return NULL; 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;
}

56
src/builtins.h
View File

@@ -3,19 +3,19 @@
#include "utility.h" #include "utility.h"
#define LISP_FUNC_0(func_name) \ #define LISP_FUNC_0(func_name, state_name) \
static struct ucl_object *func_name##_impl(); \ static struct ucl_object *func_name##_impl(); \
struct ucl_object *func_name(struct ucl_object *args) { \ struct ucl_object *func_name(struct ucl_state *state, struct ucl_object *args) { \
if (args->cell.car != NULL) { \ if (args->cell.car != NULL) { \
return NULL; \ return NULL; \
} \ } \
return func_name##_impl(); \ return func_name##_impl(state_name); \
} \ } \
static struct ucl_object *func_name##_impl() static struct ucl_object *func_name##_impl(struct ucl_state *state)
#define LISP_FUNC_1(func_name, arg0_name) \ #define LISP_FUNC_1(func_name, state_name, arg0_name) \
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); \
struct ucl_object *func_name(struct ucl_object *args) { \ struct ucl_object *func_name(struct ucl_state *state, struct ucl_object *args) { \
struct ucl_object *len_obj = ucl_list_length(args); \ struct ucl_object *len_obj = ucl_list_length(args); \
if (len_obj->type != UCL_TYPE_INT) { \ if (len_obj->type != UCL_TYPE_INT) { \
return NULL; \ return NULL; \
@@ -24,14 +24,14 @@
return NULL; \ return NULL; \
} \ } \
struct ucl_object *arg0 = ucl_car(args); \ 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) // TODO: Unroll the args more efficiently, this is O(n^2)
#define LISP_FUNC_2(func_name, arg0_name, arg1_name) \ #define LISP_FUNC_2(func_name, state_name, arg0_name, arg1_name) \
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 *func_name(struct ucl_object *args) { \ struct ucl_object *func_name(struct ucl_state *state, struct ucl_object *args) { \
struct ucl_object *len_obj = ucl_list_length(args); \ struct ucl_object *len_obj = ucl_list_length(args); \
if (len_obj->type != UCL_TYPE_INT) { \ if (len_obj->type != UCL_TYPE_INT) { \
return NULL; \ return NULL; \
@@ -41,25 +41,27 @@
} \ } \
struct ucl_object *arg0 = ucl_list_nth(args, 0); \ struct ucl_object *arg0 = ucl_list_nth(args, 0); \
struct ucl_object *arg1 = ucl_list_nth(args, 1); \ 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_error(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_type(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_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_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_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_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_add(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_sub(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_object *args); struct ucl_object *ucl_builtin_mul(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_div(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_object *args); struct ucl_object *ucl_builtin_mod(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_concat(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 #endif

27
src/evaluate.c
View File

@@ -6,6 +6,8 @@
#include "utility.h" #include "utility.h"
#include "state.h" #include "state.h"
#include <string.h>
struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object *list) { struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object *list) {
// TODO: Recursively eval args // TODO: Recursively eval args
struct ucl_object *evaluated_list = ucl_nil_create(); 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); assert(fun->type == UCL_TYPE_BUILTIN);
if (fun->type == UCL_TYPE_BUILTIN) { if (fun->type == UCL_TYPE_BUILTIN) {
result = fun->builtin(args); result = fun->builtin(state, args);
} }
// TODO: Non-builtins // TODO: Non-builtins
@@ -31,12 +33,33 @@ struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object
return result; 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) { struct ucl_object *ucl_evaluate(struct ucl_state *state, struct ucl_object *obj) {
assert(obj != NULL); assert(obj != NULL);
switch (obj->type) { switch (obj->type) {
case UCL_TYPE_CELL: case UCL_TYPE_CELL:
return ucl_evaluate_list(state, obj); return ucl_evaluate_special_form(state, obj);
case UCL_TYPE_SYMBOL: case UCL_TYPE_SYMBOL:
return ucl_state_get(state, obj->symbol); return ucl_state_get(state, obj->symbol);
case UCL_TYPE_INT: case UCL_TYPE_INT:

2
src/main.c
View File

@@ -11,6 +11,8 @@ int main(int argc, const char **argv) {
(void) argc, (void) argv; (void) argc, (void) argv;
struct ucl_state *state = ucl_state_create(); 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_add));
ucl_state_put(state, "-", ucl_builtin_create(ucl_builtin_sub)); ucl_state_put(state, "-", ucl_builtin_create(ucl_builtin_sub));
ucl_state_put(state, "*", ucl_builtin_create(ucl_builtin_mul)); ucl_state_put(state, "*", ucl_builtin_create(ucl_builtin_mul));

17
src/state.c
View File

@@ -12,12 +12,12 @@
struct ucl_state { struct ucl_state {
struct ucl_object *list; struct ucl_object *list;
struct ucl_state *parent;
}; };
#define NAME_POSITION 0 #define NAME_POSITION 0
#define DATA_POSITION 1 #define DATA_POSITION 1
static struct ucl_object *ucl_state_get_cell(struct ucl_state *state, const char *name) { static struct ucl_object *ucl_state_get_cell(struct ucl_state *state, const char *name) {
FOREACH_LIST(state->list, iter, item) { FOREACH_LIST(state->list, iter, item) {
assert(item->type == UCL_TYPE_CELL); 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 *ucl_state_get(struct ucl_state *state, const char *name) {
struct ucl_object *cell = ucl_state_get_cell(state, 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); 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 *ucl_state_create() {
struct ucl_state *state = malloc(sizeof(struct ucl_state)); struct ucl_state *state = malloc(sizeof(struct ucl_state));
state->list = ucl_nil_create(); 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; return state;
} }

2
src/state.h
View File

@@ -4,6 +4,8 @@
struct ucl_state; struct ucl_state;
struct ucl_state *ucl_state_create(); 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); void ucl_state_delete(struct ucl_state *state);
struct ucl_object *ucl_state_get(struct ucl_state *state, const char *name); struct ucl_object *ucl_state_get(struct ucl_state *state, const char *name);

3
src/uclisp.h
View File

@@ -16,7 +16,8 @@ struct ucl_cell {
struct ucl_object *cdr; 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 { struct ucl_object {
enum ucl_type type; enum ucl_type type;