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

Add defun without evaluation

Browse Source
This commit is contained in:
Max Regan
2022-11-03 09:46:23 -04:00
parent 37a614515e
commit ddb5a8f842
17 changed files with 291 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
src/builtins.c
View File

@@ -3,6 +3,7 @@
#include "utility.h"
#include "builtins.h"
#include "state.h"
#include "lisp.h"
#include <assert.h>
#include <stddef.h>
@@ -24,6 +25,8 @@ LISP_FUNC_1(ucl_builtin_type, state, arg) {
return ucl_symbol_create("error");
case UCL_TYPE_BUILTIN:
return ucl_symbol_create("builtin");
case UCL_TYPE_SPECIAL:
return ucl_symbol_create("special");
case UCL_TYPE_COUNT:
assert(0);
return NULL;
@@ -192,41 +195,6 @@ LISP_FUNC_1(ucl_builtin_print, state, arg0) {
return ucl_nil_create();
}
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
return value;
}
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) {
return result;
}
}
ucl_state_delete(let_state);
return result;
}
struct ucl_object *ucl_builtin_list(struct ucl_state *state, struct ucl_object *args) {
struct ucl_object *head = ucl_nil_create();
FOREACH_LIST(args, iter, item) {

44
src/builtins.h
View File

@@ -3,49 +3,6 @@
#include "utility.h"
#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, 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; \
} \
if (len_obj->integer != 1) { \
return NULL; \
} \
struct ucl_object *arg0 = ucl_car(args); \
return func_name##_impl(state_name, arg0); \
} \
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, 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; \
} \
if (len_obj->integer != 2) { \
return NULL; \
} \
struct ucl_object *arg0 = ucl_list_nth(args, 0); \
struct ucl_object *arg1 = ucl_list_nth(args, 1); \
return func_name##_impl(state_name, arg0, arg1); \
} \
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_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);
@@ -62,7 +19,6 @@ struct ucl_object *ucl_builtin_concat(struct ucl_state *state, struct ucl_object
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);
struct ucl_object *ucl_builtin_list(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_builtin_print(struct ucl_state *state, struct ucl_object *args);

45
src/evaluate.c
View File

@@ -9,11 +9,7 @@
// TODO: remove string.h
#include <string.h>
struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object *list) {
if (list->cell.car == NULL) {
return list;
}
struct ucl_object *ucl_evaluate_builtin_form(struct ucl_state *state, struct ucl_object *list) {
// TODO: Recursively eval args
struct ucl_object *evaluated_list = ucl_nil_create();
@@ -31,8 +27,6 @@ struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object
result = fun->builtin(state, args);
}
// TODO: Non-builtins
// TODO: cleanup
return result;
@@ -42,29 +36,45 @@ struct ucl_object *ucl_evaluate_special_form(struct ucl_state *state, struct ucl
// 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);
}
result = fun->special(state, args);
return result;
}
struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object *list) {
if (list->cell.car == NULL) {
return list;
}
struct ucl_object *fun_sym = ucl_car(list);
if (fun_sym->type != UCL_TYPE_SYMBOL) {
return ucl_error_create("Unknown function symbol");
}
struct ucl_object *fun = ucl_state_get(state, fun_sym->symbol);
UCL_RET_IF_ERROR(fun);
if (fun->type == UCL_TYPE_SPECIAL) {
return ucl_evaluate_special_form(state, list);
} else if (fun->type == UCL_TYPE_BUILTIN) {
return ucl_evaluate_builtin_form(state, list);
} else {
assert(0);
// TODO: Lisp functions and other errors
}
}
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_special_form(state, obj);
return ucl_evaluate_list(state, obj);
case UCL_TYPE_SYMBOL:
return ucl_state_get(state, obj->symbol);
case UCL_TYPE_INT:
@@ -72,6 +82,7 @@ struct ucl_object *ucl_evaluate(struct ucl_state *state, struct ucl_object *obj)
case UCL_TYPE_ERROR:
return obj;
case UCL_TYPE_BUILTIN:
case UCL_TYPE_SPECIAL:
case UCL_TYPE_COUNT:
assert(0);
return NULL;

3
src/internal.h
View File

@@ -18,7 +18,8 @@ struct ucl_object *ucl_int_create(int integer);
struct ucl_object *ucl_symbol_create(const char* symbol);
struct ucl_object *ucl_string_create(const char* string);
struct ucl_object *ucl_error_create(const char* error);
struct ucl_object *ucl_builtin_create(ucl_builtin builtin);
struct ucl_object *ucl_builtin_create(ucl_lisp builtin);
struct ucl_object *ucl_special_create(ucl_lisp special);
void ucl_object_delete(struct ucl_object *obj);

49
src/lisp.h Normal file
View File

@@ -0,0 +1,49 @@
#ifndef _UCLISP_LISP_H_
#define _UCLISP_LISP_H_
#include "uclisp.h"
#include "utility.h"
#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, 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; \
} \
if (len_obj->integer != 1) { \
return NULL; \
} \
struct ucl_object *arg0 = ucl_car(args); \
return func_name##_impl(state_name, arg0); \
} \
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, 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; \
} \
if (len_obj->integer != 2) { \
return NULL; \
} \
struct ucl_object *arg0 = ucl_list_nth(args, 0); \
struct ucl_object *arg1 = ucl_list_nth(args, 1); \
return func_name##_impl(state_name, arg0, arg1); \
} \
static struct ucl_object *func_name##_impl(struct ucl_state *state, struct ucl_object *arg0_name, struct ucl_object *arg1_name)
#endif

13
src/main.c
View File

@@ -2,16 +2,21 @@
#include <stdio.h>
#include "uclisp.h"
#include "state.h"
#include "internal.h"
#include "utility.h"
#include "builtins.h"
#include "internal.h"
#include "special.h"
#include "state.h"
#include "utility.h"
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, "let", ucl_special_create(ucl_special_let));
ucl_state_put(state, "if", ucl_special_create(ucl_special_if));
ucl_state_put(state, "print", ucl_builtin_create(ucl_builtin_print));
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));

11
src/memory.c
View File

@@ -49,7 +49,7 @@ struct ucl_object *ucl_error_create(const char *error)
}
struct ucl_object *ucl_builtin_create(ucl_builtin builtin)
struct ucl_object *ucl_builtin_create(ucl_lisp builtin)
{
struct ucl_object* obj = ucl_object_alloc();
obj->type = UCL_TYPE_BUILTIN;
@@ -57,6 +57,15 @@ struct ucl_object *ucl_builtin_create(ucl_builtin builtin)
return obj;
}
struct ucl_object *ucl_special_create(ucl_lisp special)
{
struct ucl_object* obj = ucl_object_alloc();
obj->type = UCL_TYPE_SPECIAL;
obj->special = special;
return obj;
}
static struct ucl_object* ucl_object_alloc() {
return malloc(sizeof(struct ucl_object));
}

86
src/special.c Normal file
View File

@@ -0,0 +1,86 @@
#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 = NULL;
FOREACH_LIST(expressions, iter, item) {
result = ucl_evaluate(let_state, item);
if (result->type == UCL_TYPE_ERROR) {
return result;
}
}
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);
}
struct ucl_object *result = NULL;
FOREACH_LIST(false_forms, iter, form) {
result = ucl_evaluate(state, form);
}
return (result == NULL) ? ucl_nil_create() : result;
}
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;
}

10
src/special.h Normal file
View File

@@ -0,0 +1,10 @@
#ifndef _UCLISP_SPECIAL_H_
#define _UCLISP_SPECIAL_H_
#include "uclisp.h"
struct ucl_object *ucl_special_let(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_special_if(struct ucl_state *state, struct ucl_object *args);
struct ucl_object *ucl_special_defun(struct ucl_state *state, struct ucl_object *args);
#endif

7
src/state.c
View File

@@ -69,6 +69,13 @@ struct ucl_state *ucl_state_create_child(struct ucl_state *parent) {
return state;
}
struct ucl_state *ucl_state_get_root(struct ucl_state *state) {
while (state->parent != NULL) {
state = state->parent;
}
return state;
}
void ucl_state_delete(struct ucl_state *state) {
// TODO: Cleanup
// ucl_object_delete(state->list);

1
src/state.h
View File

@@ -10,5 +10,6 @@ void ucl_state_delete(struct ucl_state *state);
struct ucl_object *ucl_state_get(struct ucl_state *state, const char *name);
void ucl_state_put(struct ucl_state *state, const char *name, struct ucl_object *obj);
struct ucl_state *ucl_state_get_root(struct ucl_state *state);
#endif

8
src/uclisp.h
View File

@@ -8,7 +8,8 @@ enum ucl_type {
UCL_TYPE_STRING = 3,
UCL_TYPE_ERROR = 4,
UCL_TYPE_BUILTIN = 5,
UCL_TYPE_COUNT = 6,
UCL_TYPE_SPECIAL = 6, // Like builtins, but special forms where arguments are not necessarily evaluated
UCL_TYPE_COUNT = 7,
};
struct ucl_cell {
@@ -17,7 +18,7 @@ struct ucl_cell {
};
struct ucl_state;
typedef struct ucl_object *(*ucl_builtin)(struct ucl_state* state, struct ucl_object *args);
typedef struct ucl_object *(*ucl_lisp)(struct ucl_state* state, struct ucl_object *args);
struct ucl_object {
enum ucl_type type;
@@ -27,7 +28,8 @@ struct ucl_object {
int integer;
const char *string;
const char *error;
ucl_builtin builtin;
ucl_lisp builtin;
ucl_lisp special;
};
};

12
src/utility.c
View File

@@ -1,5 +1,6 @@
#include "uclisp.h"
#include "internal.h"
#include "lisp.h"
#include "uclisp.h"
#include "utility.h"
#include <stddef.h>
@@ -84,7 +85,14 @@ struct ucl_object *ucl_list_nth(struct ucl_object *list, int n) {
}
struct ucl_object *ucl_truthy(struct ucl_object *obj) {
// TODO: Implement me
// TODO: Implement me better
if (obj->type == UCL_TYPE_INT) {
return ucl_predicate(obj->integer);
} else if (obj->type == UCL_TYPE_SYMBOL) {
return ucl_predicate(true);
} else if (obj->type == UCL_TYPE_CELL) {
return ucl_predicate(obj->cell.car != NULL);
}
return ucl_error_create("Unimplemented function 'ucl_truthy'");
}

5
src/utility.h
View File

@@ -21,8 +21,9 @@ struct ucl_object* ucl_tuple_create(struct ucl_object *obj0, struct ucl_object *
#define UCL_RET_IF_ERROR(obj) \
do { \
if ((obj)->type == UCL_TYPE_ERROR) { \
return obj; \
if ((obj)->type == UCL_TYPE_ERROR) { \
return obj; \
} \
} while(0)
#define UCL_COND_OR_RET_ERROR(cond, msg) \