Implement +, * and - primitives

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);
+	}
+}