play around with guile as a backend

+ I have officially devolved my language into an alternative syntax for
  Scheme. Oh well.

4 files changed, 61 insertions, 383 deletions

diff --git a/src/lookup.c b/src/lookup.c
deleted file mode 100644
index 377c505..0000000
--- a/src/lookup.c
+++ /dev/null
@@ -1,123 +0,0 @@
-#include <string.h>
-#include <stdlib.h>
-#include <lyn/lookup.h>
-
-struct lookup lookup_create(size_t s)
-{
-	return (struct lookup){.ns = s, .root = NULL};
-}
-
-unsigned long djb2(const unsigned char *str)
-{
-	unsigned long hash = 5381;
-	int c;
-
-	while ((c = *str++))
-		hash = ((hash << 5) + hash) + c; /* hash * 33 + c */
-
-	return hash;
-}
-
-static size_t lookup_size(struct lookup *l, size_t key_len)
-{
-	return sizeof(struct lookup_node) + l->ns + key_len + 1;
-}
-
-static struct lookup_node *create_node(struct lookup *l, unsigned long hash, const char *key, const void *n)
-{
-	size_t key_len = strlen(key);
-	struct lookup_node *new = malloc(lookup_size(l, key_len));
-	if (!new)
-		return NULL;
-
-	memcpy(new->data, n, l->ns);
-	strcpy(new->data + l->ns, key);
-	new->hash = hash;
-	new->left = NULL;
-	new->right = NULL;
-	return new;
-}
-
-void *lookup_insert(struct lookup *l, const char *key, const void *n)
-{
-	enum {INSERT_LEFT, INSERT_RIGHT} side = INSERT_LEFT;
-
-	unsigned long hash = djb2((const unsigned char *)key);
-	if (!l->root) {
-		struct lookup_node *new = create_node(l, hash, key, n);
-		if (!new)
-			return NULL;
-
-		l->root = new;
-		return &new->data;
-	}
-
-	struct lookup_node *cmp = l->root;
-	while (cmp) {
-		if (cmp->hash == hash) {
-			if (strcmp(cmp->data + l->ns, key) == 0)
-				return NULL;
-
-			if (cmp->left) {
-				cmp = cmp->left;
-				continue;
-			}
-
-			side = INSERT_LEFT;
-			break;
-		}
-		else if (cmp->hash < hash) {
-			if (cmp->left) {
-				cmp = cmp->left;
-				continue;
-			}
-
-			side = INSERT_LEFT;
-			break;
-		}
-		else if (cmp->hash > hash) {
-			if (cmp->right) {
-				cmp = cmp->right;
-				continue;
-			}
-
-			side = INSERT_RIGHT;
-			break;
-		}
-	}
-
-	struct lookup_node *new = create_node(l, hash, key, n);
-	if (!new)
-		return NULL;
-
-	if (side == INSERT_LEFT)
-		cmp->left = new;
-	else if (side == INSERT_RIGHT)
-		cmp->right = new;
-	else
-		abort();
-
-	return &new->data;
-}
-
-void *lookup_at(struct lookup *l, const char *key)
-{
-	unsigned long hash = djb2((const unsigned char *)key);
-	struct lookup_node *n = l->root;
-	while (n) {
-		if (n->hash == hash) {
-			if (strcmp(n->data + l->ns, key) == 0)
-				return &n->data;
-
-			n = n->left;
-		}
-		else if (n->hash < hash) {
-			n = n->left;
-		}
-		else if (n->hash > hash) {
-			n = n->right;
-		}
-	}
-
-	return NULL;
-}
diff --git a/src/lyn.c b/src/lyn.c
index bd5dbb4..fd2b802 100644
--- a/src/lyn.c
+++ b/src/lyn.c
@@ -11,288 +11,73 @@
 #include <lyn/parser.h>
 #include <lyn/debug.h>
 
-static int builtin_let(struct lyn *lyn, struct vec args)
+int eval_group(struct lyn *lyn, struct lyn_value value)
 {
-	assert(vec_len(&args) == 3);
+	fprintf(lyn->output, "(begin");
 
-	struct lyn_value name = lyn_at(args, 1);
-	assert(name.kind == LYN_ID);
-
-	struct lyn_value value = lyn_at(args, 2);
-	if (lyn_eval(lyn, value))
-		return -1;
-
-	value = lyn_res(lyn);
-	assert(value.kind == LYN_INT);
-
-	return lyn_create_symbol(lyn, name.s, lyn_var(value));
-}
-
-static int builtin_set(struct lyn *lyn, struct vec args)
-{
-	assert(vec_len(&args) == 3);
-
-	struct lyn_value name = lyn_at(args, 1);
-	assert(name.kind == LYN_ID);
-
-	struct lyn_value value = lyn_at(args, 2);
-	if (lyn_eval(lyn, value))
-		return -1;
-
-	value = lyn_res(lyn);
-	assert(value.kind == LYN_INT);
-
-	return lyn_replace_symbol(lyn, name.s, lyn_var(value));
-}
-
-static int builtin_for(struct lyn *lyn, struct vec args)
-{
-	assert(vec_len(&args) == 5);
-
-	struct lyn_value init = lyn_at(args, 1);
-	struct lyn_value cond = lyn_at(args, 2);
-	struct lyn_value post = lyn_at(args, 3);
-	struct lyn_value body = lyn_at(args, 4);
-
-	if (lyn_eval(lyn, init))
-		return -1;
-
-top:
-	if (lyn_eval(lyn, cond))
-		return -1;
-
-	struct lyn_value check = lyn_res(lyn);
-	assert(check.kind == LYN_INT);
-
-	if (check.i) {
-		if (lyn_eval(lyn, body))
-			return -1;
-
-		if (lyn_eval(lyn, post))
+	lyn->depth++;
+	foreach_vec(gi, value.args) {
+		fprintf(lyn->output, "\n%*s(", 2 * lyn->depth, " ");
+		struct lyn_value arg = lyn_at(value.args, gi);
+		if (lyn_eval(lyn, arg))
 			return -1;
 
-		goto top;
+		fprintf(lyn->output, ")");
 	}
+	fprintf(lyn->output, "\n%*s)", 2 * lyn->depth, " ");
+	lyn->depth--;
 
 	return 0;
 }
 
-static int builtin_println(struct lyn *lyn, struct vec args)
+int eval_apply(struct lyn *lyn, struct lyn_value value)
 {
-	assert(vec_len(&args) == 2);
-
-	struct lyn_value value = lyn_at(args, 1);
-	if (lyn_eval(lyn, value))
-		return -1;
-
-	value = lyn_res(lyn);
-	assert(value.kind == LYN_INT);
-
-	printf("%lld\n", value.i);
-	return 0;
-}
-
-static int builtin_lt(struct lyn *lyn, struct vec args)
-{
-	assert(vec_len(&args) == 3);
-	struct lyn_value left = lyn_at(args, 1);
-	struct lyn_value right = lyn_at(args, 2);
-
-	if (lyn_eval(lyn, left))
-		return -1;
-
-	left = lyn_res(lyn);
-	assert(left.kind == LYN_INT);
-
-	if (lyn_eval(lyn, right))
-		return -1;
-
-	right = lyn_res(lyn);
-	assert(right.kind == LYN_INT);
-
-	lyn_return(lyn, gen_int(left.i < right.i));
-	return 0;
-}
-
-static int builtin_plus(struct lyn *lyn, struct vec args)
-{
-	assert(vec_len(&args) == 3);
-	struct lyn_value left = lyn_at(args, 1);
-	struct lyn_value right = lyn_at(args, 2);
-
-	if (lyn_eval(lyn, left))
-		return -1;
-
-	left = lyn_res(lyn);
-	assert(left.kind == LYN_INT);
-
-	if (lyn_eval(lyn, right))
-		return -1;
-
-	right = lyn_res(lyn);
-	assert(right.kind == LYN_INT);
-
-	lyn_return(lyn, gen_int(left.i + right.i));
-	return 0;
-}
-
-struct lyn lyn_create()
-{
-	return (struct lyn){};
-}
-
-int lyn_create_scope(struct lyn *lyn)
-{
-	struct lyn_scope *scope = calloc(1, sizeof(struct lyn_scope));
-	if (!scope)
-		return -1;
-
-	scope->visible = lookup_create(sizeof(struct lyn_symbol));
-	scope->parent = lyn->cur;
-
-	if (!lyn->root)
-		lyn->root = scope;
-
-	lyn->cur = scope;
-	return 0;
-}
-
-static struct lyn_symbol *scope_find(struct lyn_scope *scope, const char *name)
-{
-	return lookup_at(&scope->visible, name);
-}
-
-static struct lyn_symbol *scopes_find(struct lyn_scope *scope, const char *name)
-{
-	while (scope) {
-		struct lyn_symbol *s = scope_find(scope, name);
-		if (s)
-			return s;
-
-		scope = scope->parent;
-	}
-
-	return NULL;
-}
-
-static int scope_add(struct lyn_scope *scope, const char *name, struct lyn_symbol symb)
-{
-	if (!lookup_insert(&scope->visible, name, &symb)) {
-		error("%s exists in scope\n", name);
-		return -1;
-	}
-
-	return 0;
-}
-
-int lyn_create_symbol(struct lyn *lyn, const char *name, struct lyn_symbol symb)
-{
-	return scope_add(lyn->cur, name, symb);
-}
-
-struct lyn_symbol *lyn_lookup_symbol(struct lyn *lyn, const char *name)
-{
-	return scopes_find(lyn->cur, name);
-}
-
-int lyn_replace_symbol(struct lyn *lyn, const char *name, struct lyn_symbol symb)
-{
-	struct lyn_symbol *s = scopes_find(lyn->cur, name);
-	if (!s)
-		return -1;
-
-	*s = symb;
-	return 0;
-}
-
-int lyn_init(struct lyn *lyn)
-{
-	if (lyn_create_scope(lyn))
-		return -1;
-
-	if (lyn_create_symbol(lyn, "let", lyn_syntax(builtin_let)))
-		return -1;
-
-	if (lyn_create_symbol(lyn, "for", lyn_syntax(builtin_for)))
-		return -1;
-
-	if (lyn_create_symbol(lyn, "set", lyn_syntax(builtin_set)))
-		return -1;
-
-	if (lyn_create_symbol(lyn, "println", lyn_proc(builtin_println)))
-		return -1;
-
-	if (lyn_create_symbol(lyn, "<", lyn_proc(builtin_lt)))
-		return -1;
-
-	if (lyn_create_symbol(lyn, "+", lyn_proc(builtin_plus)))
-		return -1;
-
-	return 0;
-}
-
-static int eval_group(struct lyn *lyn, struct lyn_value group)
-{
-	assert(group.kind == LYN_GROUP);
-	foreach_vec(gi, group.args) {
-		struct lyn_value arg = lyn_at(group.args, gi);
+	fprintf(lyn->output, "(");
+	foreach_vec(ai, value.args) {
+		struct lyn_value arg = lyn_at(value.args, ai);
 		if (lyn_eval(lyn, arg))
 			return -1;
 	}
 
+	fprintf(lyn->output, ")");
 	return 0;
 }
 
-static int eval_apply(struct lyn *lyn, struct lyn_value apply)
+int eval_cmd(struct lyn *lyn, struct lyn_value value)
 {
-	assert(apply.kind == LYN_APPLY);
-	foreach_vec(ai, apply.args) {
-		struct lyn_value arg = lyn_at(apply.args, ai);
+	foreach_vec(ci, value.args) {
+		struct lyn_value arg = lyn_at(value.args, ci);
 		if (lyn_eval(lyn, arg))
 			return -1;
-	}
 
+		/* don't print a space after the last argument */
+		if (ci < vec_len(&value.args) - 1)
+			fprintf(lyn->output, " ");
+	}
 	return 0;
 }
 
-int lyn_apply_cmd(struct lyn *lyn, struct lyn_symbol *cmd, struct vec args)
+int eval_str(struct lyn *lyn, struct lyn_value value)
 {
-	switch (cmd->kind) {
-	case LYN_BUILTIN_SYNTAX: return cmd->call(lyn, args);
-	case LYN_BUILTIN_PROC: return cmd->call(lyn, args);
-	default: abort();
-	}
-
+	fprintf(lyn->output, "%s", value.s);
 	return 0;
 }
 
-static int eval_cmd(struct lyn *lyn, struct lyn_value cmd)
+int eval_int(struct lyn *lyn, struct lyn_value value)
 {
-	assert(cmd.kind == LYN_CMD);
-
-	struct lyn_value name = lyn_at(cmd.args, 0);
-
-	/* to start with */
-	struct lyn_symbol *symb = lyn_lookup_symbol(lyn, name.s);
-	assert(symb);
-
-	return lyn_apply_cmd(lyn, symb, cmd.args);
+	fprintf(lyn->output, "%lld", value.i);
+	return 0;
 }
 
-static int eval_int(struct lyn *lyn, struct lyn_value i)
+int eval_float(struct lyn *lyn, struct lyn_value value)
 {
-	assert(i.kind == LYN_INT);
-	lyn_return(lyn, i);
+	fprintf(lyn->output, "%f", value.d);
 	return 0;
 }
 
-static int eval_id(struct lyn *lyn, struct lyn_value id)
+int eval_id(struct lyn *lyn, struct lyn_value value)
 {
-	assert(id.kind == LYN_ID);
-	struct lyn_symbol *symb = lyn_lookup_symbol(lyn, id.s);
-	assert(symb && symb->kind == LYN_VAR);
-
-	lyn_return(lyn, symb->value);
+	fprintf(lyn->output, "%s", value.s);
 	return 0;
 }
 
@@ -301,10 +86,11 @@ int lyn_eval(struct lyn *lyn, struct lyn_value value)
 	switch (value.kind) {
 	case LYN_GROUP: return eval_group(lyn, value);
 	case LYN_APPLY: return eval_apply(lyn, value);
+	case LYN_STR: return eval_str(lyn, value);
 	case LYN_CMD: return eval_cmd(lyn, value);
 	case LYN_INT: return eval_int(lyn, value);
 	case LYN_ID: return eval_id(lyn, value);
-	default: error("unhandled case in interp eval"); break;
+	default: error("unhandled case during 'eval'"); break;
 	}
 
 	return -1;
@@ -325,7 +111,31 @@ int lyn_eval_str(struct lyn *lyn, const char *name, const char *str)
 		return -1;
 
 	ast_dump(0, ast);
-	return lyn_eval(lyn, ast);
+
+	lyn->output = fopen("/tmp/output.scm", "w");
+	if (!lyn->output) {
+		error("failed opening output file\n");
+		return -1;
+	}
+
+	fprintf(lyn->output, "(define-syntax-rule (expand expr) expr)\n");
+	fprintf(lyn->output, "(define (get expr) expr)\n");
+
+	int ret = 0;
+	foreach_vec(ii, ast.args) {
+		fprintf(lyn->output, "(");
+		struct lyn_value v = lyn_at(ast.args, ii);
+		if ((ret = lyn_eval(lyn, v)))
+			break;
+
+		fprintf(lyn->output, ")\n");
+	}
+	fclose(lyn->output);
+
+	if (ret)
+		return ret;
+
+	return system("guile /tmp/output.scm");
 }
 
 /**
@@ -380,14 +190,9 @@ int lyn_eval_file(struct lyn *lyn, const char *fname)
 	return ret;
 }
 
-void lyn_return(struct lyn *lyn, struct lyn_value ast)
-{
-	lyn->res = ast;
-}
-
-struct lyn_value lyn_res(struct lyn *lyn)
+struct lyn lyn_create()
 {
-	return lyn->res;
+	return (struct lyn){};
 }
 
 void lyn_destroy(struct lyn *lyn)
diff --git a/src/main.c b/src/main.c
index 4e368f5..63ce86b 100644
--- a/src/main.c
+++ b/src/main.c
@@ -9,11 +9,6 @@ int main(int argc, char *argv[])
 	}
 
 	struct lyn lyn = lyn_create();
-	if (lyn_init(&lyn)) {
-		lyn_destroy(&lyn);
-		return -1;
-	}
-
 	int ret = lyn_eval_file(&lyn, argv[1]);
 	lyn_destroy(&lyn);
 	return ret;
diff --git a/src/parser.y b/src/parser.y
index 742bc5f..7b49eb8 100644
--- a/src/parser.y
+++ b/src/parser.y
@@ -164,6 +164,7 @@ cmds
 
 input
 	: cmds {$1.kind = LYN_GROUP; parser->tree = $1;}
+	| error {parser->failed = true;}
 
 %%