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 {
-	expr_t *env, *expr, *val;
+typedef struct am {
+	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);
+	}
+}