Start refacting bootstrap interpreter

Seperate code analysis and evaluation process within interpreter.

source/CMakeLists.txt

+
+# Cherry bootstrap interpreter
+add_executable(bootstrap-cherry bootstrap.c)
+target_link_libraries(bootstrap-cherry gc)
+
+

source/bootstrap.c

+/*
+ * Cherry programming language
+ * Copyright (C) 2013 Christoph Mueller
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*/
+
+#include "bootstrap.h"
+#include <gc.h>
+#include <stdarg.h>
+
+// ----------------------------------------------------------------------------
+// Default symbols
+// ----------------------------------------------------------------------------
+struct value*    True = NULL;
+struct value*    False = NULL;
+struct value*    Emptylist = NULL;
+struct value*	 Dot = NULL;
+struct value*	 Quote = NULL;
+struct value*	 Define = NULL;
+struct value*	 Let = NULL;
+struct value*	 Lambda = NULL;
+struct value*	 If = NULL;
+
+static void
+failure(const byte_t* format, ...)
+{
+	va_list args;
+	va_start(args, format);
+
+	vfprintf(stderr, format, args);
+	fprintf(stderr, "\n");
+
+	va_end(args);
+
+	exit(EXIT_FAILURE);
+}
+
+struct value*   
+alloc_value(void)
+{
+	struct value* value = GC_MALLOC(sizeof(struct value));
+
+	if(value == NULL) {
+		failure("Boehm GC: out of memory in value allocation");
+	}
+
+	return value;
+}
+
+struct value*   
+symbol(const byte_t* symbol_value)
+{
+	struct value* v = alloc_value();
+	v->tag = SYMBOL;
+	v->symbol_value = symbol_value;
+	return v;
+}
+
+struct value*   
+fixnum(fixnum_t fixnum_value)
+{
+	struct value* v = alloc_value();
+	v->tag = FIXNUM;
+	v->fixnum_value = fixnum_value;
+	return v;
+}
+
+struct value*   
+floatpoint(float_t float_value)
+{
+	struct value* v = alloc_value();
+	v->tag = FLOAT;
+	v->float_value = float_value;
+	return v;
+}
+
+struct value*   
+string(const byte_t* string_value)
+{
+	struct value* v = alloc_value();
+	v->tag = STRING;
+	v->string_value = string_value;
+	return v;
+}
+
+struct value*   
+primitive(const primitive_t fun_value)
+{
+	struct value* v = alloc_value();
+	v->tag = PRIMITIVE;
+	v->fun_value = fun_value;
+	return v;
+}
+
+struct value*   
+lambda(struct value* param, struct value* body)
+{
+	struct value* v = alloc_value();
+	v->tag = LAMBDA;
+	v->lambda.param = param;
+	v->lambda.body = body;
+	return v;
+}
+
+struct value*   
+tuple(size_t size, ...)
+{
+	struct value* v = alloc_value();
+	v->tag = TUPLE;
+	v->tuple.size = size;
+	v->tuple.data = GC_MALLOC(sizeof(struct value*) * size);
+
+	if(v->tuple.data == NULL)
+		failure("Boehm GC: Out of memory in tuple allocation");
+
+	va_list args;
+	va_start(args, size);
+
+	struct value* arg = va_arg(args, struct value*);
+	int i;
+
+	for(i = 0; i < size && arg; ++i) {
+		v->tuple.data[i] = arg;
+		arg = va_arg(args, struct value*);
+	}
+
+	va_end(args);
+
+	return v;
+}
+
+struct value*   
+dup(struct value* value)
+{
+	struct value* cpy = alloc_value();
+	memcpy(cpy, value, sizeof(struct value));
+	return cpy;
+}
+
+
+struct value*   
+cons(struct value* head, struct value* tail)
+{
+	struct value* v = alloc_value();
+	v->tag = PAIR;
+	HEAD(v) = head;
+	TAIL(v) = tail;
+	return v;
+}
+
+
+int main(int argc, char** argv)
+{
+	return 0;
+}
+
+
+void
+initialize(void)
+{
+	GC_INIT();
+
+	True = alloc_value();
+	True->tag = BOOLEAN;
+	True->fixnum_value = TRUE;
+
+	False = alloc_value();
+	False->tag = BOOLEAN;
+	False->fixnum_value = FALSE;
+
+	Dot = alloc_value();
+	Dot->tag = DOT;
+
+	Emptylist = alloc_value();
+	Emptylist->tag = EMPTYLIST;
+
+	Quote = symbol("quote");
+	Define = symbol("define");
+	Let	   = symbol("let");
+	Lambda = symbol("lambda");
+	If	   = symbol("If");
+}
+
+// ----------------------------------------------------------------------------
+// compile
+// ----------------------------------------------------------------------------
+
+
+
+struct value*	
+read(FILE* filename)
+{
+	return NULL;
+}
+
+// ----------------------------------------------------------------------------
+// compile
+// ----------------------------------------------------------------------------
+
+
+struct closure*
+compile(struct value* ast, struct value* env)
+{
+	return NULL;
+}
+
+
+struct value*
+eval(struct closure* code)
+{
+	return EXECUTE(code);
+}
+
+// ----------------------------------------------------------------------------
+// printing 
+// ----------------------------------------------------------------------------
+
+static void 
+write_tuple(FILE* out, struct value* value)
+{
+	struct value** p = TUPLE_DATA(value);
+	struct value** e = TUPLE_DATA(value) + TUPLE_SIZE(value);
+
+	write(out, *p);
+	p++;
+
+	while(p < e) {
+		fprintf(out, " ");
+		write(out, *p);
+		p++;
+	}	
+}
+
+static void
+write_pair(FILE* out, struct value* value)
+{
+	struct value* head = HEAD(value);
+	struct value* tail = TAIL(value);
+
+	write(out, head);
+	
+	if(IS_PAIR(tail)) {
+		fprintf(out, " ");
+		write_pair(out, tail);
+	} else if(IS_NULL(tail)) {
+		return;
+	} else if(IS_DOT(tail)) {
+		write_pair(out, tail);
+	} else
+		failure("Unexpected value found in write");
+}
+
+
+void
+write(FILE* out, struct value* value)
+{
+	const byte_t* p;
+
+	switch(value->tag) {
+		case EMPTYLIST:
+			fprintf(out, "()");
+			break;
+
+		case BOOLEAN:
+			fprintf(out, (value->fixnum_value) ? "true" : "false");
+			break;
+
+		case DOT:
+			fprintf(out, " . ");
+			break;
+
+		case SYMBOL:
+			fprintf(out, "%s", value->symbol_value);
+			break;
+
+		case FIXNUM:
+			fprintf(out, "%ld", value->fixnum_value);
+			break;
+
+		case FLOAT:
+			fprintf(out, "%lf", value->float_value);
+			break;
+
+		case CHAR:
+			fprintf(out, "\\");
+			switch(value->char_value) {
+				case '\0':
+					fprintf(out, "null");
+					break;
+				case '\a':
+					fprintf(out, "bell");
+					break;
+				case '\b':
+					fprintf(out, "backspace");
+					break;
+				case '\f':
+					fprintf(out, "formfeed");
+					break;
+				case '\n': 
+					fprintf(out, "newline");
+					break;
+				case ' ':
+					fprintf(out, "space");
+					break;
+				case '\r':
+					fprintf(out, "return");
+					break;
+				case '\t':
+					fprintf(out, "tab");
+					break;
+				case '\v':
+					fprintf(out, "vtab");
+					break;
+				default:
+					fprintf(out, "%c", (char) value->char_value);
+			}
+			break;
+
+		case STRING:
+			p = value->string_value;
+			fprintf(out, "\"");
+			while(*p != '\0') {
+				switch(*p) {
+					case '\a':
+						fprintf(out, "\\a");
+						break;
+					case '\b':
+						fprintf(out, "\\b");
+						break;
+					case '\f':
+						fprintf(out, "\\f");
+						break;
+					case '\n': 
+						fprintf(out, "\\n");
+						break;
+					case '\r':
+						fprintf(out, "\\r");
+						break;
+					case '\t':
+						fprintf(out, "\\t");
+						break;
+					case '\v':
+						fprintf(out, "\v");
+					case '"':
+						fprintf(out, "\\\"");
+						break;
+					case '\\':
+						fprintf(out, "\\");
+						break;
+					default:
+						fprintf(out, "%c", *p);
+				}
+				p++;
+			}
+			fprintf(out, "\"");
+			break;
+
+		case PRIMITIVE:
+			fprintf(out, "#primitive-procedure");
+			break;
+
+		case LAMBDA:
+			fprintf(out, "#lambda-procedure");
+			break;
+
+		case PAIR:
+			fprintf(out, "(");
+			write_pair(out, value);
+			fprintf(out, ")");
+			break;
+
+		case TUPLE:
+			fprintf(out, "[");
+			write_tuple(out, value);
+			fprintf(out, "]");
+			break;
+
+		default:
+			failure("cannot write an unknown value type");
+	}
+}

source/bootstrap.h

+/*
+ * Cherry programming language
+ * Copyright (C) 2013 Christoph Mueller
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*/
+#pragma once
+
+#include <stdio.h>
+#include <stdint.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <string.h>
+
+struct value;
+
+#define TRUE 1
+#define FALSE 0
+
+typedef void*           pointer_t;
+typedef const void*     const_pointer_t;
+
+typedef uint8_t         byte_t;
+typedef int64_t         fixnum_t;
+typedef double          float_t;
+typedef char            boolean_t;
+typedef uint32_t        unicode_t;
+
+typedef struct value*   (*primitive_t)(struct value* env, struct value* args);
+
+enum tag {
+  EMPTYLIST, BOOLEAN, DOT, FIXNUM, FLOAT, STRING, CHAR, PAIR, TUPLE, SYMBOL, PRIMITIVE, LAMBDA
+};
+
+struct value {
+  enum tag tag;
+
+  union {
+    fixnum_t fixnum_value;
+    float_t float_value;
+    unicode_t char_value;
+    primitive_t fun_value;
+    const byte_t* string_value;
+    const byte_t* symbol_value;
+
+    struct {
+      struct value* head;
+      struct value* tail;
+    } pair;
+
+    struct {
+      struct value** data;
+      size_t size;
+    } tuple;
+
+    struct {
+      struct value* param;
+      struct value* body;
+    } lambda;
+  };
+};
+
+#define TYPE(value) (value->tag)
+
+#define IS_NULL(value) (value->tag == EMPTYLIST)
+#define IS_BOOLEAN(value) (value->tag == BOOLEAN)
+#define IS_DOT(value) (value->tag == DOT)
+#define IS_FIXNUM(value) (value->tag == FIXNUM)
+#define IS_STRING(value) (value->tag == STRING)
+#define IS_SYMBOL(value) (value->tag == SYMBOL)
+#define IS_FLOAT(value) (value->tag == FLOAT)
+#define IS_CHAR(value) (value->tag == CHAR)
+#define IS_PAIR(value) (value->tag == PAIR)
+#define IS_PRIMITIVE(value) (value->tag == PRIMITIVE)
+#define IS_LAMBDA(value) (value->tag == LAMBDA)
+
+#define HEAD(obj) (obj->pair.head)
+#define TAIL(obj) (obj->pair.tail)
+
+#define TUPLE_DATA(obj) (obj->tuple.data)
+#define TUPLE_SIZE(obj) (obj->tuple.size)
+
+#define LAMBDA_PARAM(obj) (obj->lambda.param)
+#define LAMBDA_BODY(obj) (obj->lambda.body)
+
+extern struct value*    True;
+extern struct value*    False;
+extern struct value*    Emptylist;
+extern struct value*    Dot;
+extern struct value*    Let;
+extern struct value*    Lambda;
+extern struct value*    If;
+
+
+struct value*   alloc_value(void);
+struct value*   symbol(const byte_t* symbol_value);
+struct value*   fixnum(fixnum_t fixnum_value);
+struct value*   floatpoint(float_t float_value);
+struct value*   string(const byte_t* string_value);
+struct value*   primitive(const primitive_t fun_value);
+struct value*   lambda(struct value* param, struct value* body);
+struct value*   tuple(size_t size, ...);
+
+struct value*   dup(struct value* value);
+
+struct value*   cons(struct value* head, struct value* tail);
+
+#define list2(A, B) cons(A cons(B, emptylist))
+#define list3(A, B, C) cons(A, cons(B, cons(C, emptylist)))
+#define list4(A, B, C, D) cons(A, cons(B, cons(C, cons(D, emptylist))))
+
+struct closure {
+    struct value* (*execute)(struct closure* self);
+    struct value* env;
+};
+
+#define EXECUTE(obj) (((struct closure*) obj)->execute((struct closure*)obj))
+
+void                initialize(void);
+struct value*       read(FILE* filename);
+struct closure*     compile(struct value* ast, struct value* env);
+struct value*       eval(struct closure* code);
+void                write(FILE* out, struct value* v);
+
+