Implement +, * and - primitives

lib/CMakeLists.txt

@@ -5,6 +5,7 @@ add_library(imp
   expr.c
   memory_stream.c
   parse.c
+  prim.c
   store.c
   token.c
 )

lib/env.c

@@ -1,5 +1,7 @@
 #include "env.h"
 
+#include "prim.h"
+
 #include <assert.h>
 #include <string.h>
 
@@ -50,6 +52,7 @@ static expr_t **lookup(am_t *am, bool *found)
 void env_init(am_t *am, store_t *store)
 {
 	am->env = expr_empty_list(store);
+	prim_load(am, store);
 }
 
 void env_fetch(am_t *am)

lib/include/am.h

@@ -5,8 +5,8 @@
 
 #define AM_STACK_SIZE 128U
 
-typedef struct {
+typedef struct am {
-	expr_t *env, *expr, *val;
+	expr_t *argl, *env, *expr, *val;
 	expr_t **sp, *stack[AM_STACK_SIZE];
 } am_t;
 

lib/include/prim.h

@@ -0,0 +1,10 @@
+#ifndef PRIM_H
+#define PRIM_H
+
+#include "am.h"
+#include "expr.h"
+#include "store.h"
+
+void prim_load(am_t *am, store_t *store);
+
+#endif

lib/prim.c

@@ -0,0 +1,74 @@
+#include "prim.h"
+
+#include "env.h"
+
+#include <assert.h>
+
+#define NELEMS(arr) (sizeof(arr) / sizeof(arr[0]))
+
+typedef struct {
+	const char *name;
+	prim_proc_t prim_proc;
+} prim_table_entry_t;
+
+static void add(am_t *am, store_t *store)
+{
+	assert(am->argl);
+
+	int64_t total = 0;
+	for (expr_t *list = am->argl; !list->is_atom; list = list->pair.cdr) {
+		assert(list->pair.car->is_atom);
+		assert(list->pair.car->atom.type == ATOM_TYPE_INTEGER);
+		total += list->pair.car->atom.integer;
+	}
+	am->val = expr_integer(store, total);
+}
+
+static void mul(am_t *am, store_t *store)
+{
+	assert(am->argl);
+
+	int64_t total = 1;
+	for (expr_t *list = am->argl; !list->is_atom; list = list->pair.cdr) {
+		assert(list->pair.car->is_atom);
+		assert(list->pair.car->atom.type == ATOM_TYPE_INTEGER);
+		total *= list->pair.car->atom.integer;
+	}
+	am->val = expr_integer(store, total);
+}
+
+static void sub(am_t *am, store_t *store)
+{
+	assert(am->argl);
+	assert(!am->argl->is_atom);
+	assert(am->argl->pair.car->is_atom);
+	assert(am->argl->pair.car->atom.type == ATOM_TYPE_INTEGER);
+
+	int64_t total = am->argl->pair.car->atom.integer;
+	if (!am->argl->is_atom && am->argl->pair.cdr->is_atom) {
+		total *= -1;
+	} else {
+		for (expr_t *list = am->argl->pair.cdr; !list->is_atom;
+		     list = list->pair.cdr) {
+			assert(list->pair.car->is_atom);
+			assert(list->pair.car->atom.type == ATOM_TYPE_INTEGER);
+			total -= list->pair.car->atom.integer;
+		}
+	}
+	am->val = expr_integer(store, total);
+}
+
+static const prim_table_entry_t prim_table[] = {
+	{ "+", add },
+	{ "*", mul },
+	{ "-", sub },
+};
+
+void prim_load(am_t *am, store_t *store)
+{
+	for (unsigned i = 0; i < NELEMS(prim_table); ++i) {
+		am->expr = expr_str_symbol(store, prim_table[i].name);
+		am->val = expr_prim_proc(store, prim_table[i].prim_proc);
+		env_set(am, store);
+	}
+}

tests/CMakeLists.txt

@@ -14,6 +14,7 @@ add_test_suites(
   eval_tests.c
   expr_tests.c
   parse_tests.c
+  prim_tests.c
   store_tests.c
   token_tests.c
 )

tests/prim_tests.c

@@ -0,0 +1,147 @@
+#include "env.h"
+#include "prim.h"
+#include "unity.h"
+
+static am_t am;
+static store_t store;
+
+void setUp(void)
+{
+	am_init(&am);
+	store_init(&store);
+	env_init(&am, &store);
+}
+
+void tearDown(void)
+{
+}
+
+static void test_add_empty_list_is_0(void)
+{
+	am.expr = expr_str_symbol(&store, "+");
+	env_fetch(&am);
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_PRIM_PROC, am.val->atom.type);
+
+	am.argl = expr_empty_list(&store);
+	am.val->atom.prim_proc(&am, &store);
+
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_INTEGER, am.val->atom.type);
+	TEST_ASSERT_EQUAL(0, am.val->atom.integer);
+}
+
+static void test_add_1_2_3_is_6(void)
+{
+	am.expr = expr_str_symbol(&store, "+");
+	env_fetch(&am);
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_PRIM_PROC, am.val->atom.type);
+
+	am.argl = expr_pair(
+	    &store, expr_integer(&store, 1),
+	    expr_pair(
+	        &store, expr_integer(&store, 2),
+	        expr_pair(
+	            &store, expr_integer(&store, 3), expr_empty_list(&store))));
+	am.val->atom.prim_proc(&am, &store);
+
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_INTEGER, am.val->atom.type);
+	TEST_ASSERT_EQUAL(6, am.val->atom.integer);
+}
+
+static void test_mul_empty_list_is_1(void)
+{
+	am.expr = expr_str_symbol(&store, "*");
+	env_fetch(&am);
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_PRIM_PROC, am.val->atom.type);
+
+	am.argl = expr_empty_list(&store);
+	am.val->atom.prim_proc(&am, &store);
+
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_INTEGER, am.val->atom.type);
+	TEST_ASSERT_EQUAL(1, am.val->atom.integer);
+}
+
+static void test_mul_2_3_4_is_24(void)
+{
+	am.expr = expr_str_symbol(&store, "*");
+	env_fetch(&am);
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_PRIM_PROC, am.val->atom.type);
+
+	am.argl = expr_pair(
+	    &store, expr_integer(&store, 2),
+	    expr_pair(
+	        &store, expr_integer(&store, 3),
+	        expr_pair(
+	            &store, expr_integer(&store, 4), expr_empty_list(&store))));
+	am.val->atom.prim_proc(&am, &store);
+
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_INTEGER, am.val->atom.type);
+	TEST_ASSERT_EQUAL(24, am.val->atom.integer);
+}
+
+static void test_sub_1_is_minus_1(void)
+{
+	am.expr = expr_str_symbol(&store, "-");
+	env_fetch(&am);
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_PRIM_PROC, am.val->atom.type);
+
+	am.argl = expr_pair(
+	    &store, expr_integer(&store, 1), expr_empty_list(&store));
+	am.val->atom.prim_proc(&am, &store);
+
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_INTEGER, am.val->atom.type);
+	TEST_ASSERT_EQUAL(-1, am.val->atom.integer);
+}
+
+static void test_sub_5_4_3_is_minus_2(void)
+{
+	am.expr = expr_str_symbol(&store, "-");
+	env_fetch(&am);
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_PRIM_PROC, am.val->atom.type);
+
+	am.argl = expr_pair(
+	    &store, expr_integer(&store, 5),
+	    expr_pair(
+	        &store, expr_integer(&store, 4),
+	        expr_pair(
+	            &store, expr_integer(&store, 3), expr_empty_list(&store))));
+	am.val->atom.prim_proc(&am, &store);
+
+	TEST_ASSERT_NOT_NULL(am.val);
+	TEST_ASSERT_TRUE(am.val->is_atom);
+	TEST_ASSERT_EQUAL(ATOM_TYPE_INTEGER, am.val->atom.type);
+	TEST_ASSERT_EQUAL(-2, am.val->atom.integer);
+}
+
+int main(void)
+{
+	UNITY_BEGIN();
+	RUN_TEST(test_add_empty_list_is_0);
+	RUN_TEST(test_add_1_2_3_is_6);
+	RUN_TEST(test_mul_empty_list_is_1);
+	RUN_TEST(test_mul_2_3_4_is_24);
+	RUN_TEST(test_sub_1_is_minus_1);
+	RUN_TEST(test_sub_5_4_3_is_minus_2);
+	return UNITY_END();
+}