Add error types and simple state

SConstruct

@@ -8,10 +8,11 @@ build_dir = "build/default/"
 src_dir = "src/"
 
 program_sources = ["src/main.c"]
-lib_srcs = ["src/parse.c", "src/memory.c", "src/builtins.c", "src/evaluate.c", "src/utility.c"]
+lib_srcs = ["src/parse.c", "src/memory.c", "src/builtins.c", "src/evaluate.c", "src/utility.c", "src/state.c"]
 lib_includes = ["src/"]
 
-test_srcs = ["test/test_parse.c", "test/test_utility.c"]
+
+test_srcs = ["test/test_parse.c", "test/test_utility.c", "test/test_state.c"]
 test_lib_srcs = ["third-party/unity/src/unity.c"]
 test_lib_includes = ["third-party/unity/src/"]
 

src/builtins.c

@@ -22,12 +22,22 @@ LISP_FUNC_1(nl_builtin_type, arg) {
             return nl_symbol_create(strdup("int"));
         case NL_TYPE_STRING:
             return nl_symbol_create(strdup("string"));
+        case NL_TYPE_ERROR:
+            return nl_symbol_create(strdup("error"));
         case NL_TYPE_COUNT:
             assert(0);
             return NULL;
     }
 }
 
+LISP_FUNC_1(nl_builtin_error, arg) {
+    if (arg->type != NL_TYPE_STRING) {
+        return nl_error_create("Expected type string passed to 'error'");
+    }
+
+    return nl_error_create(strdup(arg->error));
+}
+
 LISP_FUNC_1(nl_builtin_symbol_p, arg) {
     return nl_predicate(arg->type == NL_TYPE_SYMBOL);
 }
@@ -44,6 +54,10 @@ LISP_FUNC_1(nl_builtin_list_p, arg) {
     return nl_predicate(arg->type == NL_TYPE_CELL);
 }
 
+LISP_FUNC_1(nl_builtin_error_p, arg) {
+    return nl_predicate(arg->type == NL_TYPE_ERROR);
+}
+
 LISP_FUNC_1(nl_builtin_car, arg) {
     return nl_car(arg);
 }
@@ -53,78 +67,72 @@ LISP_FUNC_1(nl_builtin_cdr, arg) {
 }
 
 LISP_FUNC_2(nl_builtin_add, arg0, arg1) {
-    // TODO: Return an error type
+    if (arg0->type != NL_TYPE_INT) {
-    if (arg0->type != arg1->type) {
+        return nl_error_create("Invalid type of argument 0 to 'add'");
-        return NULL;
     }
 
-    if (arg0->type != NL_TYPE_INT) {
+    if (arg1->type != NL_TYPE_INT) {
-        return NULL;
+        return nl_error_create("Invalid type of argument 1 to 'add'");
     }
 
     return nl_int_create(arg0->integer + arg1->integer);
 }
 
 LISP_FUNC_2(nl_builtin_sub, arg0, arg1) {
-    // TODO: Return an error type
+    if (arg0->type != NL_TYPE_INT) {
-    if (arg0->type != arg1->type) {
+        return nl_error_create("Invalid type of argument 0 to 'sub'");
-        return NULL;
     }
 
-    if (arg0->type != NL_TYPE_INT) {
+    if (arg1->type != NL_TYPE_INT) {
-        return NULL;
+        return nl_error_create("Invalid type of argument 1 to 'sub'");
     }
 
     return nl_int_create(arg0->integer - arg1->integer);
 }
 
 LISP_FUNC_2(nl_builtin_mul, arg0, arg1) {
-    // TODO: Return an error type
+    if (arg0->type != NL_TYPE_INT) {
-    if (arg0->type != arg1->type) {
+        return nl_error_create("Invalid type of argument 0 to 'mul'");
-        return NULL;
     }
 
-    if (arg0->type != NL_TYPE_INT) {
+    if (arg1->type != NL_TYPE_INT) {
-        return NULL;
+        return nl_error_create("Invalid type of argument 1 to 'mul'");
     }
 
     return nl_int_create(arg0->integer * arg1->integer);
 }
 
 LISP_FUNC_2(nl_builtin_div, arg0, arg1) {
-    // TODO: Return an error type
+    if (arg0->type != NL_TYPE_INT) {
-    if (arg0->type != arg1->type) {
+        return nl_error_create("Invalid type of argument 0 to 'div'");
-        return NULL;
     }
 
-    if (arg0->type != NL_TYPE_INT) {
+    if (arg1->type != NL_TYPE_INT) {
-        return NULL;
+        return nl_error_create("Invalid type of argument 1 to 'div'");
     }
 
     return nl_int_create(arg0->integer / arg1->integer);
 }
 
 LISP_FUNC_2(nl_builtin_mod, arg0, arg1) {
-    // TODO: Return an error type
+    if (arg0->type != NL_TYPE_INT) {
-    if (arg0->type != arg1->type) {
+        return nl_error_create("Invalid type of argument 0 to 'mod'");
-        return NULL;
     }
 
-    if (arg0->type != NL_TYPE_INT) {
+    if (arg1->type != NL_TYPE_INT) {
-        return NULL;
+        return nl_error_create("Invalid type of argument 1 to 'mod'");
     }
 
     return nl_int_create(arg0->integer % arg1->integer);
 }
 
 LISP_FUNC_2(nl_builtin_concat, arg0, arg1) {
-    // TODO: Return an error type
+    if (arg0->type != NL_TYPE_STRING) {
-    if (arg0->type != arg1->type) {
+        return nl_error_create("Invalid type of argument 0 to 'concat'");
-        return NULL;
     }
 
-    if (arg0->type != NL_TYPE_STRING) {
+    if (arg1->type != NL_TYPE_STRING) {
-        return NULL;
+        return nl_error_create("Invalid type of argument 1 to 'concat'");
     }
 
     int len = strlen(arg0->string) + strlen(arg1->string);

src/builtins.h

@@ -44,6 +44,7 @@
 
 
 struct nl_object *nl_builtin_hello_world(struct nl_object *args);
+struct nl_object *nl_builtin_error(struct nl_object *args);
 struct nl_object *nl_builtin_type(struct nl_object *args);
 struct nl_object *nl_builtin_symbol_p(struct nl_object *args);
 struct nl_object *nl_builtin_string_p(struct nl_object *args);

src/main.c

@@ -1,7 +1,10 @@
 #include <stdio.h>
+#include "nihilispm.h"
+#include "nihilispm_state.h"
 
 int main(int argc, const char **argv) {
     (void) argc, (void) argv;
+    struct nl_state *state = nl_state_create();
 
     return 0;
 }

src/memory.c

@@ -40,6 +40,14 @@ struct nl_object *nl_string_create(const char *string)
     return obj;
 }
 
+struct nl_object *nl_error_create(const char *error)
+{
+    struct nl_object* obj = nl_object_alloc();
+    obj->type = NL_TYPE_ERROR;
+    obj->error = error;
+    return obj;
+}
+
 static struct nl_object* nl_object_alloc() {
     return malloc(sizeof(struct nl_object));
 }
@@ -63,6 +71,11 @@ void nl_object_delete(struct nl_object *obj) {
         case NL_TYPE_STRING:
             free((void *) obj->string);
             obj->string = NULL;
+            break;
+        case NL_TYPE_ERROR:
+            free((void *) obj->error);
+            obj->error = NULL;
+            break;
         case NL_TYPE_INT:
         case NL_TYPE_COUNT:
             break;

src/nihilispm.h

@@ -6,7 +6,8 @@ enum nl_type {
     NL_TYPE_SYMBOL = 1,
     NL_TYPE_INT = 2,
     NL_TYPE_STRING = 3,
-    NL_TYPE_COUNT = 4,
+    NL_TYPE_ERROR = 4,
+    NL_TYPE_COUNT = 5,
 };
 
 struct nl_cell {
@@ -21,6 +22,7 @@ struct nl_object {
         const char *symbol;
         int integer;
         const char *string;
+        const char *error;
     };
 };
 

src/nihilispm_internal.h

@@ -1,4 +1,5 @@
 #include "nihilispm.h"
+#include <stddef.h>
 
 #define ARRAY_SIZE(x) sizeof(x) / sizeof(x[0])
 #define FOREACH_LIST(list, iter_name, item_name) \
@@ -6,15 +7,15 @@
 
 #define FOREACH_LIST_COND(list, iter_name, item_name, cond) \
     for (struct nl_object *iter_name = (list), *item_name = iter_name->cell.car; \
-         iter_name != NULL && (cond); \
+         item_name != NULL && iter_name != NULL && (cond); \
-         iter_name = token->cell.cdr, item_name = iter_name->cell.car)
+         iter_name = iter_name->cell.cdr, item_name = (iter_name == NULL) ? NULL : iter_name->cell.car)
 
 
 struct nl_object *nl_cell_create(struct nl_object *car, struct nl_object *cdr);
 struct nl_object *nl_int_create(int integer);
 struct nl_object *nl_symbol_create(const char* symbol);
 struct nl_object *nl_string_create(const char* string);
-
+struct nl_object *nl_error_create(const char* error);
 
 void nl_object_delete(struct nl_object *obj);
 

src/nihilispm_state.h

@@ -0,0 +1,11 @@
+#ifndef _NIHILISPM_STATE_H_
+#define _NIHILISPM_STATE_H_
+struct nl_state;
+
+struct nl_state *nl_state_create();
+void nl_state_delete(struct nl_state *state);
+
+struct nl_object *nl_state_get(struct nl_state *state, const char *name);
+void nl_state_put(struct nl_state *state, const char *name, struct nl_object *obj);
+
+#endif

src/nihilispm_utility.h

@@ -16,11 +16,11 @@ struct nl_object* nl_list_append(struct nl_object *list, struct nl_object *obj);
 struct nl_object* nl_tuple_create(struct nl_object *obj0, struct nl_object *obj1);
 
 
-/* #define NL_RET_IF_ERROR(obj)                    \ */
+#define NL_RET_IF_ERROR(obj)                    \
-/*     do {                                        \ */
+    do {                                        \
-/*     if ((obj)->type == NL_TYPE_ERROR) {         \ */
+    if ((obj)->type == NL_TYPE_ERROR) {         \
-/*         return obj;                             \ */
+        return obj;                             \
-/*     } while(0) */
+    } while(0)
 
 #define NL_COND_OR_RET_ERROR(cond, msg)             \
     do {                                            \

src/state.c

@@ -0,0 +1,60 @@
+#include "nihilispm.h"
+#include "nihilispm_internal.h"
+#include "nihilispm_state.h"
+#include "nihilispm_utility.h"
+
+#include <assert.h>
+#include <string.h>
+#include <stdlib.h>
+
+// Implements state as a giant alist
+// TODO: Consider generalizing the alist concept
+
+struct nl_state {
+    struct nl_object *list;
+};
+
+#define NAME_POSITION 0
+#define DATA_POSITION 1
+
+
+static struct nl_object *nl_state_get_cell(struct nl_state *state, const char *name) {
+    FOREACH_LIST(state->list, iter, item) {
+        assert(item->type == NL_TYPE_CELL);
+        const char *item_name = nl_list_nth(item, NAME_POSITION)->string;
+        if (!strcmp(name, item_name)) {
+            return item;
+        }
+    }
+
+    return NULL;
+}
+
+struct nl_object *nl_state_get(struct nl_state *state, const char *name) {
+    struct nl_object *cell = nl_state_get_cell(state, name);
+    NL_COND_OR_RET_ERROR(cell != NULL, "Unknown name");
+    return nl_list_nth(cell, DATA_POSITION);
+}
+
+void nl_state_put(struct nl_state *state, const char *name, struct nl_object *obj) {
+    struct nl_object *cell = nl_state_get_cell(state, name);
+    if (cell == NULL) {
+        nl_list_append(state->list,
+                       nl_tuple_create(
+                           nl_string_create(strdup(name)),
+                           obj));
+    } else {
+        // TODO: Refcounting / cleanup
+        cell->cell.cdr->cell.car = obj;
+    }
+}
+
+struct nl_state *nl_state_create() {
+    struct nl_state *state = malloc(sizeof(struct nl_state));
+    state->list = nl_nil_create();
+    return state;
+}
+
+void nl_state_delete(struct nl_state *state) {
+    nl_object_delete(state->list);
+}

src/utility.c

@@ -7,9 +7,9 @@
 #include <string.h>
 
 struct nl_object *nl_car(struct nl_object *list) {
-    if (list == NULL || list->type != NL_TYPE_CELL) {
+    NL_COND_OR_RET_ERROR(
-        return NULL; // TODO: Return an error type
+        list != NULL && list->type == NL_TYPE_CELL,
-    }
+        "Invalid type of argument 0 to 'nl_car'");
 
     struct nl_object *car = list->cell.car;
     if (car == NULL) {
@@ -20,9 +20,9 @@ struct nl_object *nl_car(struct nl_object *list) {
 }
 
 struct nl_object *nl_cdr(struct nl_object *list) {
-    if (list == NULL || list->type != NL_TYPE_CELL) {
+    NL_COND_OR_RET_ERROR(
-        return NULL; // TODO: Return an error type
+        list != NULL && list->type == NL_TYPE_CELL,
-    }
+        "Invalid type of argument 0 to 'nl_cdr'");
 
     struct nl_object *cdr = list->cell.cdr;
     if (cdr == NULL) {
@@ -49,9 +49,9 @@ struct nl_object *nl_predicate(bool value) {
 }
 
 struct nl_object *nl_list_length(struct nl_object *list) {
-    if (list == NULL || list->type != NL_TYPE_CELL) {
+    NL_COND_OR_RET_ERROR(
-        return NULL; // TODO: Return an error type
+        list != NULL && list->type == NL_TYPE_CELL,
-    }
+        "Invalid type of argument 0 to 'nl_list_length'");
 
     struct nl_object *node = list;
     if (list->cell.car == NULL) {
@@ -68,14 +68,12 @@ struct nl_object *nl_list_length(struct nl_object *list) {
 }
 
 struct nl_object *nl_list_nth(struct nl_object *list, int n) {
-    if (list == NULL || list->type != NL_TYPE_CELL) {
+    NL_COND_OR_RET_ERROR(
-        return NULL; // TODO: Return an error type
+        list != NULL && list->type == NL_TYPE_CELL,
-    }
+        "Invalid type of argument 0 to 'nl_list_'");
 
     int length = nl_list_length(list)->integer;
-    if (length <= n) {
+    NL_COND_OR_RET_ERROR(length > n, "Position n >= list length in nl_list_nth");
-        return NULL; // TODO: Return an error type
-    }
 
     struct nl_object *node = list;
     for (int i = 0; i < n; i++) {
@@ -87,7 +85,7 @@ struct nl_object *nl_list_nth(struct nl_object *list, int n) {
 
 struct nl_object *nl_truthy(struct nl_object *obj) {
     // TODO: Implement me
-    return NULL;
+    return nl_error_create("Unimplemented function 'nl_truthy'");
 }
 
 struct nl_object *nl_tuple_create(struct nl_object *obj0, struct nl_object *obj1) {

test/test_state.c

@@ -0,0 +1,66 @@
+#include <unity.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "nihilispm.h"
+#include "nihilispm_internal.h"
+#include "nihilispm_state.h"
+#include "nihilispm_utility.h"
+#include "testing_helpers.h"
+
+/* static struct nl_parse_result *result; */
+static struct nl_state *state;
+static struct nl_object *response;
+
+void setUp(void) {
+    state = nl_state_create();
+}
+
+void tearDown(void) {
+    nl_state_delete(state);
+    state = NULL;
+}
+
+static void test_get_empty(void) {
+    response = nl_state_get(state, "foo");
+    TEST_ASSERT_OBJ_ERROR(response);
+}
+
+static void test_put_get(void) {
+    nl_state_put(state, "foo", nl_t_create());
+    response = nl_state_get(state, "foo");
+    TEST_ASSERT_T(response);
+}
+
+static void test_put2_get(void) {
+    nl_state_put(state, "foo1", nl_t_create());
+    nl_state_put(state, "foo2", nl_nil_create());
+    response = nl_state_get(state, "foo1");
+    TEST_ASSERT_T(response);
+}
+
+static void test_put_modify_get(void) {
+    struct nl_object *obj = nl_tuple_create(
+        nl_string_create(strdup("bar")),
+        nl_string_create(strdup("baz")));
+
+    nl_state_put(state, "foo", obj);
+    nl_list_append(obj, nl_string_create(strdup("quux")));
+    response = nl_state_get(state, "foo");
+
+    TEST_ASSERT_OBJ_STRING(nl_list_nth(response, 2));
+    TEST_ASSERT_EQUAL_STRING(nl_list_nth(response, 2)->string, "quux");
+
+    TEST_ASSERT_OBJ_STRING(nl_list_nth(obj, 2));
+    TEST_ASSERT_EQUAL_STRING(nl_list_nth(obj, 2)->string, "quux");
+}
+
+
+int main(void) {
+    UNITY_BEGIN();
+    RUN_TEST(test_get_empty);
+    RUN_TEST(test_put_get);
+    RUN_TEST(test_put2_get);
+    RUN_TEST(test_put_modify_get);
+    return UNITY_END();
+}

test/test_utility.c

@@ -5,38 +5,11 @@
 #include "nihilispm.h"
 #include "nihilispm_internal.h"
 #include "nihilispm_utility.h"
+#include "testing_helpers.h"
 
 static struct nl_object *input;
 static struct nl_object *response;
 
-#define TEST_ASSERT_OBJ_SYMBOL(obj)                 \
-    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_SYMBOL)
-
-#define TEST_ASSERT_OBJ_STRING(obj)                 \
-    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_STRING)
-
-#define TEST_ASSERT_OBJ_INT(obj)                 \
-    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_INT)
-
-#define TEST_ASSERT_OBJ_LIST(obj)               \
-    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_CELL)
-
-#define TEST_ASSERT_LIST_LEN(list, len)                         \
-    do {                                                        \
-        TEST_ASSERT_OBJ_LIST(list);                             \
-        TEST_ASSERT_EQUAL(nl_list_length(list)->integer, len);  \
-    } while(0)
-
-#define TEST_ASSERT_NIL(obj) \
-    TEST_ASSERT_LIST_LEN(obj, 0)
-
-#define TEST_ASSERT_T(obj)                              \
-    do {                                                \
-        TEST_ASSERT_OBJ_SYMBOL(obj);                    \
-        TEST_ASSERT_EQUAL_STRING(obj->symbol, "t");     \
-    } while(0)
-
-
 void setUp(void) {
     input = NULL;
     response = NULL;
@@ -89,13 +62,13 @@ static void test_cdr_nil(void) {
 static void test_car_t(void) {
     response = nl_car(nl_t_create());
 
-    TEST_ASSERT_NULL(response);
+    TEST_ASSERT_OBJ_ERROR(response);
 }
 
 static void test_cdr_t(void) {
     response = nl_car(nl_t_create());
 
-    TEST_ASSERT_NULL(response);
+    TEST_ASSERT_OBJ_ERROR(response);
 }
 
 static void test_car_list(void) {
@@ -160,13 +133,13 @@ static void test_list_append_list() {
 static void test_list_nth_nil_0() {
     response = nl_list_nth(nl_nil_create(), 0);
 
-    TEST_ASSERT_NULL(response);
+    TEST_ASSERT_OBJ_ERROR(response);
 }
 
 static void test_list_nth_nil_1() {
     response = nl_list_nth(nl_nil_create(), 1);
 
-    TEST_ASSERT_NULL(response);
+    TEST_ASSERT_OBJ_ERROR(response);
 }
 
 static void test_list_nth_list_0() {
@@ -189,9 +162,42 @@ static void test_list_nth_list_1() {
     TEST_ASSERT_OBJ_STRING(response);
 }
 
+static void test_list_nth_t_0() {
+    response = nl_list_nth(nl_t_create(), 1);
+
+    TEST_ASSERT_OBJ_ERROR(response);
+}
+
+static void test_list_nth_bounds_0() {
+    response = nl_list_nth(nl_nil_create(), 0);
+
+    TEST_ASSERT_OBJ_ERROR(response);
+}
+
+static void test_list_nth_bounds_1() {
+    response = nl_list_nth(
+        nl_cell_create(
+            nl_nil_create(),
+            NULL),
+        1);
+
+    TEST_ASSERT_OBJ_ERROR(response);
+}
+
+static void test_list_nth_bounds_2() {
+    response = nl_list_nth(
+        nl_tuple_create(
+            nl_nil_create(),
+            nl_nil_create()),
+        2);
+
+    TEST_ASSERT_OBJ_ERROR(response);
+}
+
 
 int main(void) {
     UNITY_BEGIN();
+
     RUN_TEST(test_nil_create);
     RUN_TEST(test_t_create);
     RUN_TEST(test_predicate_true);
@@ -211,5 +217,10 @@ int main(void) {
     RUN_TEST(test_list_nth_nil_1);
     RUN_TEST(test_list_nth_list_0);
     RUN_TEST(test_list_nth_list_1);
+    RUN_TEST(test_list_nth_t_0);
+    RUN_TEST(test_list_nth_bounds_0);
+    RUN_TEST(test_list_nth_bounds_1);
+    RUN_TEST(test_list_nth_bounds_2);
+
     return UNITY_END();
 }

test/testing_helpers.h

@@ -0,0 +1,38 @@
+#ifndef _TESTING_HELPERS_H_
+#define _TESTING_HELPERS_H_
+
+#include <unity.h>
+
+#include "nihilispm.h"
+
+#define TEST_ASSERT_OBJ_ERROR(obj)              \
+    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_ERROR)
+
+#define TEST_ASSERT_OBJ_SYMBOL(obj)                 \
+    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_SYMBOL)
+
+#define TEST_ASSERT_OBJ_STRING(obj)                 \
+    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_STRING)
+
+#define TEST_ASSERT_OBJ_INT(obj)                \
+    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_INT)
+
+#define TEST_ASSERT_OBJ_LIST(obj)               \
+    TEST_ASSERT_EQUAL(obj->type, NL_TYPE_CELL)
+
+#define TEST_ASSERT_LIST_LEN(list, len)                         \
+    do {                                                        \
+        TEST_ASSERT_OBJ_LIST(list);                             \
+        TEST_ASSERT_EQUAL(nl_list_length(list)->integer, len);  \
+    } while(0)
+
+#define TEST_ASSERT_NIL(obj)                    \
+    TEST_ASSERT_LIST_LEN(obj, 0)
+
+#define TEST_ASSERT_T(obj)                          \
+    do {                                            \
+        TEST_ASSERT_OBJ_SYMBOL(obj);                \
+        TEST_ASSERT_EQUAL_STRING(obj->symbol, "t"); \
+    } while(0)
+
+#endif