Add defun without evaluation
This commit is contained in:
13
SConstruct
13
SConstruct
@@ -11,21 +11,22 @@ src_dir = "src/"
|
|||||||
|
|
||||||
program_sources = ["src/main.c"]
|
program_sources = ["src/main.c"]
|
||||||
lib_srcs = [
|
lib_srcs = [
|
||||||
"src/parse.c",
|
|
||||||
"src/memory.c",
|
|
||||||
"src/builtins.c",
|
"src/builtins.c",
|
||||||
"src/evaluate.c",
|
"src/evaluate.c",
|
||||||
"src/utility.c",
|
"src/memory.c",
|
||||||
|
"src/special.c",
|
||||||
"src/state.c",
|
"src/state.c",
|
||||||
|
"src/utility.c",
|
||||||
|
"src/parse.c",
|
||||||
]
|
]
|
||||||
lib_includes = ["src/"]
|
lib_includes = ["src/"]
|
||||||
|
|
||||||
|
|
||||||
test_srcs = [
|
test_srcs = [
|
||||||
"test/test_parse.c",
|
|
||||||
"test/test_utility.c",
|
|
||||||
"test/test_state.c",
|
|
||||||
"test/test_e2e.c",
|
"test/test_e2e.c",
|
||||||
|
"test/test_parse.c",
|
||||||
|
"test/test_state.c",
|
||||||
|
"test/test_utility.c",
|
||||||
]
|
]
|
||||||
test_lib_srcs = ["third-party/unity/src/unity.c"]
|
test_lib_srcs = ["third-party/unity/src/unity.c"]
|
||||||
test_lib_includes = ["third-party/unity/src/"]
|
test_lib_includes = ["third-party/unity/src/"]
|
||||||
|
|||||||
@@ -3,6 +3,7 @@
|
|||||||
#include "utility.h"
|
#include "utility.h"
|
||||||
#include "builtins.h"
|
#include "builtins.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
|
#include "lisp.h"
|
||||||
|
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
#include <stddef.h>
|
#include <stddef.h>
|
||||||
@@ -24,6 +25,8 @@ LISP_FUNC_1(ucl_builtin_type, state, arg) {
|
|||||||
return ucl_symbol_create("error");
|
return ucl_symbol_create("error");
|
||||||
case UCL_TYPE_BUILTIN:
|
case UCL_TYPE_BUILTIN:
|
||||||
return ucl_symbol_create("builtin");
|
return ucl_symbol_create("builtin");
|
||||||
|
case UCL_TYPE_SPECIAL:
|
||||||
|
return ucl_symbol_create("special");
|
||||||
case UCL_TYPE_COUNT:
|
case UCL_TYPE_COUNT:
|
||||||
assert(0);
|
assert(0);
|
||||||
return NULL;
|
return NULL;
|
||||||
@@ -192,41 +195,6 @@ LISP_FUNC_1(ucl_builtin_print, state, arg0) {
|
|||||||
return ucl_nil_create();
|
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 *ucl_builtin_list(struct ucl_state *state, struct ucl_object *args) {
|
||||||
struct ucl_object *head = ucl_nil_create();
|
struct ucl_object *head = ucl_nil_create();
|
||||||
FOREACH_LIST(args, iter, item) {
|
FOREACH_LIST(args, iter, item) {
|
||||||
|
|||||||
@@ -3,49 +3,6 @@
|
|||||||
|
|
||||||
#include "utility.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)
|
|
||||||
|
|
||||||
|
|
||||||
struct ucl_object *ucl_builtin_error(struct ucl_state *state, 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_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_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_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_list(struct ucl_state *state, struct ucl_object *args);
|
||||||
struct ucl_object *ucl_builtin_print(struct ucl_state *state, struct ucl_object *args);
|
struct ucl_object *ucl_builtin_print(struct ucl_state *state, struct ucl_object *args);
|
||||||
|
|
||||||
|
|||||||
@@ -9,11 +9,7 @@
|
|||||||
// TODO: remove string.h
|
// TODO: remove string.h
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object *list) {
|
struct ucl_object *ucl_evaluate_builtin_form(struct ucl_state *state, struct ucl_object *list) {
|
||||||
if (list->cell.car == NULL) {
|
|
||||||
return 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();
|
||||||
|
|
||||||
@@ -31,8 +27,6 @@ struct ucl_object *ucl_evaluate_list(struct ucl_state *state, struct ucl_object
|
|||||||
result = fun->builtin(state, args);
|
result = fun->builtin(state, args);
|
||||||
}
|
}
|
||||||
|
|
||||||
// TODO: Non-builtins
|
|
||||||
|
|
||||||
// TODO: cleanup
|
// TODO: cleanup
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
@@ -42,29 +36,45 @@ struct ucl_object *ucl_evaluate_special_form(struct ucl_state *state, struct ucl
|
|||||||
// TODO: Recursively eval args
|
// TODO: Recursively eval args
|
||||||
const char *fun_sym = ucl_car(list)->symbol;
|
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 *fun = ucl_state_get(state, ucl_car(list)->symbol);
|
||||||
struct ucl_object *args = ucl_cdr(list);
|
struct ucl_object *args = ucl_cdr(list);
|
||||||
struct ucl_object *result = NULL;
|
struct ucl_object *result = NULL;
|
||||||
|
|
||||||
assert(fun->type == UCL_TYPE_BUILTIN);
|
result = fun->special(state, args);
|
||||||
if (fun->type == UCL_TYPE_BUILTIN) {
|
|
||||||
// TODO: check for errors
|
|
||||||
result = fun->builtin(state, args);
|
|
||||||
}
|
|
||||||
|
|
||||||
return result;
|
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) {
|
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_special_form(state, obj);
|
return ucl_evaluate_list(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:
|
||||||
@@ -72,6 +82,7 @@ struct ucl_object *ucl_evaluate(struct ucl_state *state, struct ucl_object *obj)
|
|||||||
case UCL_TYPE_ERROR:
|
case UCL_TYPE_ERROR:
|
||||||
return obj;
|
return obj;
|
||||||
case UCL_TYPE_BUILTIN:
|
case UCL_TYPE_BUILTIN:
|
||||||
|
case UCL_TYPE_SPECIAL:
|
||||||
case UCL_TYPE_COUNT:
|
case UCL_TYPE_COUNT:
|
||||||
assert(0);
|
assert(0);
|
||||||
return NULL;
|
return NULL;
|
||||||
|
|||||||
@@ -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_symbol_create(const char* symbol);
|
||||||
struct ucl_object *ucl_string_create(const char* string);
|
struct ucl_object *ucl_string_create(const char* string);
|
||||||
struct ucl_object *ucl_error_create(const char* error);
|
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);
|
void ucl_object_delete(struct ucl_object *obj);
|
||||||
|
|
||||||
|
|||||||
49
src/lisp.h
Normal file
49
src/lisp.h
Normal 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
13
src/main.c
@@ -2,16 +2,21 @@
|
|||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
#include "uclisp.h"
|
#include "uclisp.h"
|
||||||
#include "state.h"
|
|
||||||
#include "internal.h"
|
|
||||||
#include "utility.h"
|
|
||||||
#include "builtins.h"
|
#include "builtins.h"
|
||||||
|
#include "internal.h"
|
||||||
|
#include "special.h"
|
||||||
|
#include "state.h"
|
||||||
|
#include "utility.h"
|
||||||
|
|
||||||
int main(int argc, const char **argv) {
|
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, "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, "print", ucl_builtin_create(ucl_builtin_print));
|
||||||
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));
|
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));
|
||||||
|
|
||||||
|
|||||||
11
src/memory.c
11
src/memory.c
@@ -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();
|
struct ucl_object* obj = ucl_object_alloc();
|
||||||
obj->type = UCL_TYPE_BUILTIN;
|
obj->type = UCL_TYPE_BUILTIN;
|
||||||
@@ -57,6 +57,15 @@ struct ucl_object *ucl_builtin_create(ucl_builtin builtin)
|
|||||||
return obj;
|
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() {
|
static struct ucl_object* ucl_object_alloc() {
|
||||||
return malloc(sizeof(struct ucl_object));
|
return malloc(sizeof(struct ucl_object));
|
||||||
}
|
}
|
||||||
|
|||||||
86
src/special.c
Normal file
86
src/special.c
Normal 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
10
src/special.h
Normal 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
|
||||||
@@ -69,6 +69,13 @@ struct ucl_state *ucl_state_create_child(struct ucl_state *parent) {
|
|||||||
return state;
|
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) {
|
void ucl_state_delete(struct ucl_state *state) {
|
||||||
// TODO: Cleanup
|
// TODO: Cleanup
|
||||||
// ucl_object_delete(state->list);
|
// ucl_object_delete(state->list);
|
||||||
|
|||||||
@@ -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);
|
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);
|
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
|
#endif
|
||||||
|
|||||||
@@ -8,7 +8,8 @@ enum ucl_type {
|
|||||||
UCL_TYPE_STRING = 3,
|
UCL_TYPE_STRING = 3,
|
||||||
UCL_TYPE_ERROR = 4,
|
UCL_TYPE_ERROR = 4,
|
||||||
UCL_TYPE_BUILTIN = 5,
|
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 {
|
struct ucl_cell {
|
||||||
@@ -17,7 +18,7 @@ struct ucl_cell {
|
|||||||
};
|
};
|
||||||
|
|
||||||
struct ucl_state;
|
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 {
|
struct ucl_object {
|
||||||
enum ucl_type type;
|
enum ucl_type type;
|
||||||
@@ -27,7 +28,8 @@ struct ucl_object {
|
|||||||
int integer;
|
int integer;
|
||||||
const char *string;
|
const char *string;
|
||||||
const char *error;
|
const char *error;
|
||||||
ucl_builtin builtin;
|
ucl_lisp builtin;
|
||||||
|
ucl_lisp special;
|
||||||
};
|
};
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
#include "uclisp.h"
|
|
||||||
#include "internal.h"
|
#include "internal.h"
|
||||||
|
#include "lisp.h"
|
||||||
|
#include "uclisp.h"
|
||||||
#include "utility.h"
|
#include "utility.h"
|
||||||
|
|
||||||
#include <stddef.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) {
|
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'");
|
return ucl_error_create("Unimplemented function 'ucl_truthy'");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -23,6 +23,7 @@ struct ucl_object* ucl_tuple_create(struct ucl_object *obj0, struct ucl_object *
|
|||||||
do { \
|
do { \
|
||||||
if ((obj)->type == UCL_TYPE_ERROR) { \
|
if ((obj)->type == UCL_TYPE_ERROR) { \
|
||||||
return obj; \
|
return obj; \
|
||||||
|
} \
|
||||||
} while(0)
|
} while(0)
|
||||||
|
|
||||||
#define UCL_COND_OR_RET_ERROR(cond, msg) \
|
#define UCL_COND_OR_RET_ERROR(cond, msg) \
|
||||||
|
|||||||
@@ -8,6 +8,7 @@
|
|||||||
#include "testing_helpers.h"
|
#include "testing_helpers.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "builtins.h"
|
#include "builtins.h"
|
||||||
|
#include "special.h"
|
||||||
|
|
||||||
static struct ucl_object *input;
|
static struct ucl_object *input;
|
||||||
static struct ucl_object *response;
|
static struct ucl_object *response;
|
||||||
@@ -18,7 +19,8 @@ void setUp(void) {
|
|||||||
response = NULL;
|
response = NULL;
|
||||||
|
|
||||||
state = ucl_state_create();
|
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, "defun", ucl_special_create(ucl_special_defun));
|
||||||
ucl_state_put(state, "+", ucl_builtin_create(ucl_builtin_add));
|
ucl_state_put(state, "+", ucl_builtin_create(ucl_builtin_add));
|
||||||
ucl_state_put(state, "error", ucl_builtin_create(ucl_builtin_error));
|
ucl_state_put(state, "error", ucl_builtin_create(ucl_builtin_error));
|
||||||
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));
|
ucl_state_put(state, "list", ucl_builtin_create(ucl_builtin_list));
|
||||||
@@ -39,77 +41,77 @@ static struct ucl_object *eval (const char *code) {
|
|||||||
return ucl_evaluate(state, ucl_car(sexp));
|
return ucl_evaluate(state, ucl_car(sexp));
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_simple_add(void) {
|
void test_simple_add(void) {
|
||||||
ucl_state_put(state, "+", ucl_builtin_create(ucl_builtin_add));
|
ucl_state_put(state, "+", ucl_builtin_create(ucl_builtin_add));
|
||||||
response = eval("(+ 2 3)");
|
response = eval("(+ 2 3)");
|
||||||
TEST_ASSERT_OBJ_INT(response);
|
TEST_ASSERT_OBJ_INT(response);
|
||||||
TEST_ASSERT_EQUAL(response->integer, 5);
|
TEST_ASSERT_EQUAL(response->integer, 5);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_simple_let(void) {
|
void test_simple_let(void) {
|
||||||
response = eval("(let ((x 2)) (+ x 3))");
|
response = eval("(let ((x 2)) (+ x 3))");
|
||||||
TEST_ASSERT_OBJ_INT(response);
|
TEST_ASSERT_OBJ_INT(response);
|
||||||
TEST_ASSERT_EQUAL(response->integer, 5);
|
TEST_ASSERT_EQUAL(response->integer, 5);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_let_assignment_error(void) {
|
void test_let_assignment_error(void) {
|
||||||
response = eval("(let ((x (error \"foo\"))) (+ x 3))");
|
response = eval("(let ((x (error \"foo\"))) (+ x 3))");
|
||||||
TEST_ASSERT_OBJ_ERROR(response);
|
TEST_ASSERT_OBJ_ERROR(response);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_nested_let(void) {
|
void test_nested_let(void) {
|
||||||
response = eval("(let ((x 2)) (let ((y 5)) (+ x y)))");
|
response = eval("(let ((x 2)) (let ((y 5)) (+ x y)))");
|
||||||
TEST_ASSERT_OBJ_INT(response);
|
TEST_ASSERT_OBJ_INT(response);
|
||||||
TEST_ASSERT_EQUAL(response->integer, 7);
|
TEST_ASSERT_EQUAL(response->integer, 7);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_nested_let_scope(void) {
|
void test_nested_let_scope(void) {
|
||||||
response = eval("(let ((x 2)) (let ((y 5)) (+ x y)) y)");
|
response = eval("(let ((x 2)) (let ((y 5)) (+ x y)) y)");
|
||||||
TEST_ASSERT_OBJ_ERROR(response);
|
TEST_ASSERT_OBJ_ERROR(response);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_multi_let(void) {
|
void test_multi_let(void) {
|
||||||
response = eval("(let ((x 2)(y 5)) (+ x y))");
|
response = eval("(let ((x 2)(y 5)) (+ x y))");
|
||||||
TEST_ASSERT_OBJ_INT(response);
|
TEST_ASSERT_OBJ_INT(response);
|
||||||
TEST_ASSERT_EQUAL(response->integer, 7);
|
TEST_ASSERT_EQUAL(response->integer, 7);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_let_return_sym(void) {
|
void test_let_return_sym(void) {
|
||||||
response = eval("(let ((x 2)) x)");
|
response = eval("(let ((x 2)) x)");
|
||||||
TEST_ASSERT_OBJ_INT(response);
|
TEST_ASSERT_OBJ_INT(response);
|
||||||
TEST_ASSERT_EQUAL(response->integer, 2);
|
TEST_ASSERT_EQUAL(response->integer, 2);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_eval_int(void) {
|
void test_eval_int(void) {
|
||||||
response = eval("2");
|
response = eval("2");
|
||||||
TEST_ASSERT_OBJ_INT(response);
|
TEST_ASSERT_OBJ_INT(response);
|
||||||
TEST_ASSERT_EQUAL(response->integer, 2);
|
TEST_ASSERT_EQUAL(response->integer, 2);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_eval_string(void) {
|
void test_eval_string(void) {
|
||||||
response = eval("\"foo\"");
|
response = eval("\"foo\"");
|
||||||
TEST_ASSERT_OBJ_STRING(response);
|
TEST_ASSERT_OBJ_STRING(response);
|
||||||
TEST_ASSERT_EQUAL_STRING(response->string, "foo");
|
TEST_ASSERT_EQUAL_STRING(response->string, "foo");
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_eval_sym_defined(void) {
|
void test_eval_sym_defined(void) {
|
||||||
ucl_state_put(state, "foo", ucl_int_create(2));
|
ucl_state_put(state, "foo", ucl_int_create(2));
|
||||||
response = eval("foo");
|
response = eval("foo");
|
||||||
TEST_ASSERT_OBJ_INT(response);
|
TEST_ASSERT_OBJ_INT(response);
|
||||||
TEST_ASSERT_EQUAL(response->integer, 2);
|
TEST_ASSERT_EQUAL(response->integer, 2);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_eval_sym_undefined(void) {
|
void test_eval_sym_undefined(void) {
|
||||||
response = eval("foo");
|
response = eval("foo");
|
||||||
TEST_ASSERT_OBJ_ERROR(response);
|
TEST_ASSERT_OBJ_ERROR(response);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_eval_nested_error(void) {
|
void test_eval_nested_error(void) {
|
||||||
response = eval("(+ (error \"foo\") 3)");
|
response = eval("(+ (error \"foo\") 3)");
|
||||||
TEST_ASSERT_OBJ_ERROR(response);
|
TEST_ASSERT_OBJ_ERROR(response);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void test_eval_list(void) {
|
void test_eval_list(void) {
|
||||||
response = eval("(list 1 2 3)");
|
response = eval("(list 1 2 3)");
|
||||||
TEST_ASSERT_OBJ_LIST(response);
|
TEST_ASSERT_OBJ_LIST(response);
|
||||||
TEST_ASSERT_EQUAL(ucl_list_length(response)->integer, 3);
|
TEST_ASSERT_EQUAL(ucl_list_length(response)->integer, 3);
|
||||||
@@ -121,6 +123,12 @@ static void test_eval_list(void) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void test_eval_defun(void) {
|
||||||
|
response = eval("(defun foo (a b) (+ a b))");
|
||||||
|
|
||||||
|
TEST_ASSERT_OBJ_SYMBOL(response);
|
||||||
|
TEST_ASSERT_EQUAL_STRING(response->symbol, "foo");
|
||||||
|
}
|
||||||
|
|
||||||
int main(void) {
|
int main(void) {
|
||||||
UNITY_BEGIN();
|
UNITY_BEGIN();
|
||||||
@@ -138,6 +146,7 @@ int main(void) {
|
|||||||
RUN_TEST(test_eval_sym_undefined);
|
RUN_TEST(test_eval_sym_undefined);
|
||||||
RUN_TEST(test_eval_nested_error);
|
RUN_TEST(test_eval_nested_error);
|
||||||
RUN_TEST(test_eval_list);
|
RUN_TEST(test_eval_list);
|
||||||
|
RUN_TEST(test_eval_defun);
|
||||||
|
|
||||||
return UNITY_END();
|
return UNITY_END();
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -5,6 +5,7 @@
|
|||||||
#include "uclisp.h"
|
#include "uclisp.h"
|
||||||
#include "internal.h"
|
#include "internal.h"
|
||||||
#include "utility.h"
|
#include "utility.h"
|
||||||
|
#include "state.h"
|
||||||
#include "testing_helpers.h"
|
#include "testing_helpers.h"
|
||||||
|
|
||||||
static struct ucl_object *input;
|
static struct ucl_object *input;
|
||||||
@@ -194,6 +195,38 @@ static void test_list_nth_bounds_2() {
|
|||||||
TEST_ASSERT_OBJ_ERROR(response);
|
TEST_ASSERT_OBJ_ERROR(response);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void test_truthy_0() {
|
||||||
|
response = ucl_truthy(ucl_int_create(0));
|
||||||
|
|
||||||
|
TEST_ASSERT_NIL(response);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void test_truthy_1() {
|
||||||
|
response = ucl_truthy(ucl_int_create(1));
|
||||||
|
|
||||||
|
TEST_ASSERT_T(response);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void test_truthy_nil() {
|
||||||
|
response = ucl_truthy(ucl_nil_create());
|
||||||
|
|
||||||
|
TEST_ASSERT_NIL(response);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void test_truthy_list_w_elem() {
|
||||||
|
struct ucl_object *list = ucl_nil_create();
|
||||||
|
ucl_list_append(list, ucl_int_create(0));
|
||||||
|
response = ucl_truthy(list);
|
||||||
|
|
||||||
|
TEST_ASSERT_T(response);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void test_truthy_sym() {
|
||||||
|
response = ucl_truthy(ucl_symbol_create("t"));
|
||||||
|
|
||||||
|
TEST_ASSERT_T(response);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
int main(void) {
|
int main(void) {
|
||||||
UNITY_BEGIN();
|
UNITY_BEGIN();
|
||||||
@@ -221,6 +254,11 @@ int main(void) {
|
|||||||
RUN_TEST(test_list_nth_bounds_0);
|
RUN_TEST(test_list_nth_bounds_0);
|
||||||
RUN_TEST(test_list_nth_bounds_1);
|
RUN_TEST(test_list_nth_bounds_1);
|
||||||
RUN_TEST(test_list_nth_bounds_2);
|
RUN_TEST(test_list_nth_bounds_2);
|
||||||
|
RUN_TEST(test_truthy_0);
|
||||||
|
RUN_TEST(test_truthy_1);
|
||||||
|
RUN_TEST(test_truthy_nil);
|
||||||
|
RUN_TEST(test_truthy_list_w_elem);
|
||||||
|
RUN_TEST(test_truthy_sym);
|
||||||
|
|
||||||
return UNITY_END();
|
return UNITY_END();
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user