play around with guile as a backend

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

11 files changed, 82 insertions, 466 deletions

diff --git a/examples/guile.lyn b/examples/guile.lyn
new file mode 100644
index 0000000..9d7f445
--- /dev/null
+++ b/examples/guile.lyn
@@ -0,0 +1,18 @@
+define-syntax-rule (for init condition post body) {
+	expand init
+	do () ((not (expand condition))) {
+		expand body
+		expand post
+	}
+}
+
+define (sum n) {
+	define s 0
+	for (define i 0) (< i n) (set! i (1+ i)) {
+		set! s (+ s i)
+	}
+	get s
+}
+
+display (sum 1000000)
+newline
diff --git a/examples/if.lyn b/examples/if.lyn
deleted file mode 100644
index 294a490..0000000
--- a/examples/if.lyn
+++ /dev/null
@@ -1,15 +0,0 @@
-# `if` macro, think of it as a statement I guess?
-# else is used by the `if` command in C, presumably?
-if {< i 10} {
-	println "a"
-} {< i 20} {
-	println "b"
-} else {
-	println "c"
-}
-
-# `if` procedure, think of it as expr-if in other languages I guess
-# note that all arguments get evaluated here, so if you have a slow function in
-# one branch you should probably prefer `if` statements
-
-let x (do-if (< i 10) "a" (< i 20) "b" else "c")
diff --git a/examples/loop.lyn b/examples/loop.lyn
deleted file mode 100644
index 0304672..0000000
--- a/examples/loop.lyn
+++ /dev/null
@@ -1,6 +0,0 @@
-let sum 0
-for {let i 0} {< i 1000000} {set i (+ i 1)} {
-	set sum (+ sum i)
-}
-
-println sum
diff --git a/examples/primitive.lyn b/examples/primitive.lyn
deleted file mode 100644
index 4ebcf74..0000000
--- a/examples/primitive.lyn
+++ /dev/null
@@ -1,5 +0,0 @@
-let x 0
-println x
-
-set x 1
-println x
diff --git a/examples/sum.lyn b/examples/sum.lyn
deleted file mode 100644
index 55338f6..0000000
--- a/examples/sum.lyn
+++ /dev/null
@@ -1,18 +0,0 @@
-syntax for {init cond post body} {
-	eval init
-	while {eval cond} {
-		eval body
-		eval post
-	}
-}
-
-def sum {n} {
-	require n int
-	let s 0
-	for {let i 0} {< i n} {set i (+ i 1)} {
-		set s (+ s i)
-	}
-	return s
-}
-
-println (sum 1000000)
diff --git a/include/lyn/lookup.h b/include/lyn/lookup.h
deleted file mode 100644
index 577d450..0000000
--- a/include/lyn/lookup.h
+++ /dev/null
@@ -1,29 +0,0 @@
-#ifndef LYN_LOOKUP_H
-#define LYN_LOOKUP_H
-
-#include <stddef.h>
-
-struct lookup_node {
-	unsigned long hash;
-	struct lookup_node *left, *right;
-	char data[]; /* should be max aligned */
-};
-
-struct lookup {
-	size_t ns;
-	struct lookup_node *root;
-};
-
-struct lookup lookup_create(size_t s);
-void lookup_destroy(struct lookup *l);
-
-void *lookup_insert(struct lookup *l, const char *key, const void *n);
-void *lookup_at(struct lookup *l, const char *key);
-
-#define lookupt_insert(type, l, key, n)\
-	(type *)lookup_insert(type, l, key, n)
-
-#define lookupt_at(type, l, key)\
-	*(type *)lookup_at(&l, key)
-
-#endif /* LYN_LOOKUP_H */
diff --git a/include/lyn/lyn.h b/include/lyn/lyn.h
index ff79979..40429c2 100644
--- a/include/lyn/lyn.h
+++ b/include/lyn/lyn.h
@@ -1,23 +1,16 @@
 #ifndef LYN_H
 #define LYN_H
 
+#include <stdio.h>
 #include <lyn/parser.h>
-#include <lyn/lookup.h>
 #include <lyn/vec.h>
 
 #define lyn_at(v, i)\
 	vect_at(struct lyn_value, v, i)
 
-struct lyn_scope {
-	struct lyn_scope *parent;
-	struct lookup visible;
-};
-
 struct lyn {
-	struct lyn_scope *root;
-	struct lyn_scope *cur;
-
-	struct lyn_value res;
+	FILE *output;
+	int depth;
 };
 
 typedef int (*lyn_call)(struct lyn *lyn, struct vec args);
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;}
 
 %%