Started basic beta shift

8 files changed, 86 insertions, 30 deletions

diff --git a/inc/log.h b/inc/log.h
index 846b4f5..079e189 100644
--- a/inc/log.h
+++ b/inc/log.h
@@ -4,8 +4,18 @@
 #ifndef CALM_LOG_H
 #define CALM_LOG_H
 
-void debug(const char *format, ...);
+#define HASH_MASK 0xffff
+
+void _debug(const char *format, ...);
 void debug_enable(int enable);
 void fatal(const char *format, ...) __attribute__((noreturn));
 
+/* #define debug(...)                                                             \ */
+/* 	do {                                                                   \ */
+/* 		_debug("%s:%d: %s:\n", __FILE__, __LINE__, __func__);          \ */
+/* 		_debug(__VA_ARGS__);                                           \ */
+/* 	} while (0) */
+
+#define debug(...) _debug(__VA_ARGS__)
+
 #endif
diff --git a/inc/term.h b/inc/term.h
index 0e5902d..d8637cc 100644
--- a/inc/term.h
+++ b/inc/term.h
@@ -49,6 +49,6 @@ void term_refer(struct term *term, size_t depth);
 char term_deref_head(struct term *term, char destroy_parents);
 char term_deref(struct term *term, char destroy_parents);
 
-void term_print(struct term *term);
+size_t term_print(struct term *term);
 
 #endif
diff --git a/src/log.c b/src/log.c
index a34c8e8..bae668f 100644
--- a/src/log.c
+++ b/src/log.c
@@ -9,7 +9,7 @@
 
 static int debug_enabled = 0;
 
-void debug(const char *format, ...)
+void _debug(const char *format, ...)
 {
 	if (!debug_enabled)
 		return;
diff --git a/src/map.c b/src/map.c
index 553bbde..799effb 100644
--- a/src/map.c
+++ b/src/map.c
@@ -7,6 +7,7 @@
 #include <map.h>
 #include <parse.h>
 #include <schedule.h>
+#include <log.h>
 
 static struct hashmap *all_terms;
 
@@ -54,7 +55,7 @@ void map_destroy(struct hashmap *map)
 void map_dump(struct hashmap *map, char all)
 {
 	fprintf(stderr, "\n---\nMap dump:\n");
-	fprintf(stderr, "type\trefs\thash\t\t\tterm\t\tparents\n");
+	fprintf(stderr, "type\trefs\thash\tterm%*sparents\n", 21, "");
 	size_t iter = 0;
 	void *iter_val;
 	while (hashmap_iter(map, &iter, &iter_val)) {
@@ -63,9 +64,9 @@ void map_dump(struct hashmap *map, char all)
 		/* 	continue; */
 
 		fprintf(stderr, "%d\t%ld\t%lx\t", term->type, term->refs,
-			term->hash);
-		term_print(term);
-		fprintf(stderr, "\t{");
+			term->hash & HASH_MASK);
+		size_t len = term_print(term);
+		fprintf(stderr, "%*s{", 25 - len, "");
 
 		size_t jiter = 0;
 		void *jiter_val;
diff --git a/src/parse.c b/src/parse.c
index e2d2498..b3840d3 100644
--- a/src/parse.c
+++ b/src/parse.c
@@ -22,7 +22,7 @@ static struct term_handle abs_blc(char **term, size_t depth)
 	} else {
 		res_term = term_new(res_type, res, depth);
 		res_term->u.abs.term = inner.term;
-		// TODO: remove hash from map_set (already in term anyway)
+		// TODO: remove hash from map_set (already in term anyway)?
 		map_set(map_all_terms(), res_term);
 	}
 
diff --git a/src/reduce.c b/src/reduce.c
index 3fc7c48..07d1bfa 100644
--- a/src/reduce.c
+++ b/src/reduce.c
@@ -9,24 +9,63 @@
 #include <log.h>
 #include <assert.h>
 
-// only substitutes (and therefore rehashes) -> no explicit beta reduction
+static struct term *shift(struct term *term, size_t level, size_t amount)
+{
+	debug("shifting %lx\n", term->hash & HASH_MASK);
+	if (term->type == VAR) {
+		if (level > term->u.var.index)
+			return term;
+		struct term *rehashed =
+			term_rehash_var(term, term->u.var.index + amount);
+		return rehashed;
+	} else if (term->type == ABS) {
+		struct term *previous = term->u.abs.term;
+		struct term *new = shift(term->u.abs.term, level + 1, amount);
+		if (previous->hash == new->hash)
+			return term; // nothing changed
+		struct term *rehashed = term_rehash_abs(term, new);
+		/* term_rehash_parents(rehashed); */
+		/* if (rehashed->u.abs.term->hash == (*substitution)->hash) */
+		/* 	term_deref_head(previous, 1); */
+		return rehashed;
+	} else if (term->type == APP) {
+		hash_t previous_lhs = term->u.app.lhs->hash;
+		hash_t previous_rhs = term->u.app.rhs->hash;
+		struct term *lhs = shift(term->u.app.lhs, level, amount);
+		struct term *rhs = shift(term->u.app.rhs, level, amount);
+		if (previous_lhs == lhs->hash && previous_rhs == rhs->hash)
+			return term; // nothing changed
+		struct term *rehashed = term_rehash_app(term, lhs, rhs);
+		/* term_rehash_parents(rehashed); */
+		return rehashed;
+	}
+	fatal("invalid type %d\n", term->type);
+}
+
+// only substitutes (and therefore increments indices and rehashes)
 static struct term *substitute(struct term *term, struct term *substitution,
 			       size_t level)
 {
-	debug("substituting %lx with %lx\n", term->hash, substitution->hash);
+	debug("substituting %lx with %lx\n", term->hash & HASH_MASK,
+	      substitution->hash & HASH_MASK);
 	if (term->type == VAR) {
 		if (term->u.var.index == level) {
+			substitution->refs += 1; // TODO: Kinda hacky
+			shift(substitution, 0, level);
+			substitution->refs -= 1;
 			return substitution;
-		} else {
+		} else if (term->u.var.index < level) {
 			term_deref(substitution, 1);
 			return term;
+		} else {
+			fatal("implement\n");
 		}
 	} else if (term->type == ABS) {
 		struct term *previous = term->u.abs.term;
 		struct term *new =
 			substitute(term->u.abs.term, substitution, level + 1);
 		if (previous->hash == new->hash)
-			return new; // nothing changed
+			return term; // nothing changed
 		struct term *rehashed = term_rehash_abs(term, new);
 		term_rehash_parents(rehashed);
 		if (rehashed->u.abs.term->hash == substitution->hash)
@@ -55,7 +94,7 @@ struct term *reduce(struct term *term)
 	if (!term_is_beta_redex(term))
 		fatal("can't reduce non-beta-redex %d\n", term->type);
 
-	debug("reducing %lx\n", term->hash);
+	debug("reducing %lx\n", term->hash & HASH_MASK);
 
 	struct term *reduced = substitute(term->u.app.lhs, term->u.app.rhs, -1);
 	return reduced;
diff --git a/src/term.c b/src/term.c
index caea6f1..7756bdc 100644
--- a/src/term.c
+++ b/src/term.c
@@ -20,7 +20,7 @@ static void term_destroy_parent(void *item)
 // this is needed to destroy possibly multiple parents
 void term_destroy_head(struct term *term, char including_parents)
 {
-	debug("destroying head of %lx\n", term->hash);
+	debug("destroying head of %lx\n", term->hash & HASH_MASK);
 
 	map_delete(map_all_terms(), term);
 
@@ -60,24 +60,23 @@ char term_is_beta_redex(struct term *term)
 	return term->type == APP && term->u.app.lhs->type == ABS;
 }
 
-void term_print(struct term *term)
+size_t term_print(struct term *term)
 {
 	switch (term->type) {
 	case ABS:
 		fprintf(stderr, "[");
-		term_print(term->u.abs.term);
+		size_t t = term_print(term->u.abs.term);
 		fprintf(stderr, "]");
-		break;
+		return 2 + t;
 	case APP:
 		fprintf(stderr, "(");
-		term_print(term->u.app.lhs);
+		size_t l = term_print(term->u.app.lhs);
 		fprintf(stderr, " ");
-		term_print(term->u.app.rhs);
+		size_t r = term_print(term->u.app.rhs);
 		fprintf(stderr, ")");
-		break;
+		return 3 + l + r;
 	case VAR:
-		fprintf(stderr, "%ld", term->u.var.index);
-		break;
+		return fprintf(stderr, "%ld", term->u.var.index);
 	default:
 		fatal("invalid type %d\n", term->type);
 	}
@@ -85,7 +84,8 @@ void term_print(struct term *term)
 
 struct term *term_rehash_abs(struct term *head, struct term *term)
 {
-	debug("rehashing abs %lx\n", head->hash);
+	debug("rehashing abs %lx (%lx)\n", head->hash & HASH_MASK,
+	      term->hash & HASH_MASK);
 	hash_t res =
 		hash((uint8_t *)&head->type, sizeof(head->type), term->hash);
 
@@ -94,11 +94,13 @@ struct term *term_rehash_abs(struct term *head, struct term *term)
 
 	struct term *match = map_get(map_all_terms(), res);
 	if (match) { // already exists
+		// TODO: something different if match->u.abs.term == term)?
 		term_refer_head(match, head->depth);
 		term_deref_head(head, 1);
 		return match;
 	} else { // create new
 		struct term *new = term_new(ABS, res, head->depth);
+		// TODO: Clone parents
 		new->u.abs.term = term;
 		map_set(map_all_terms(), new);
 		map_set(term->parents, new);
@@ -107,10 +109,12 @@ struct term *term_rehash_abs(struct term *head, struct term *term)
 	}
 }
 
+// ok main problem is reparenting substitution tickle-up
 struct term *term_rehash_app(struct term *head, struct term *lhs,
 			     struct term *rhs)
 {
-	debug("rehashing app %lx\n", head->hash);
+	debug("rehashing app %lx (%lx, %lx)\n", head->hash & HASH_MASK,
+	      lhs->hash & HASH_MASK, rhs->hash & HASH_MASK);
 	hash_t res =
 		hash((uint8_t *)&head->type, sizeof(head->type), lhs->hash);
 	res = hash((uint8_t *)&res, sizeof(res), rhs->hash);
@@ -125,6 +129,7 @@ struct term *term_rehash_app(struct term *head, struct term *lhs,
 		return match;
 	} else { // create new
 		struct term *new = term_new(APP, res, head->depth);
+		// TODO: Clone parents
 		new->u.app.lhs = lhs;
 		new->u.app.rhs = rhs;
 		map_set(map_all_terms(), new);
@@ -137,7 +142,7 @@ struct term *term_rehash_app(struct term *head, struct term *lhs,
 
 struct term *term_rehash_var(struct term *head, size_t index)
 {
-	debug("rehashing var %lx\n", head->hash);
+	debug("rehashing var %lx (%lu)\n", head->hash & HASH_MASK, index);
 	hash_t res = hash((uint8_t *)&head->type, sizeof(head->type), index);
 
 	if (res == head->hash)
@@ -149,7 +154,8 @@ struct term *term_rehash_var(struct term *head, size_t index)
 		term_deref(head, 1);
 		return match;
 	} else { // create new
-		struct term *new = term_new(APP, res, head->depth);
+		struct term *new = term_new(VAR, res, head->depth);
+		// TODO: Clone parents
 		new->u.var.index = index;
 		map_set(map_all_terms(), new);
 		term_deref_head(head, 1);
@@ -171,12 +177,11 @@ struct term *term_rehash(struct term *term)
 	fatal("invalid type %d\n", term->type);
 }
 
-// returns the direct parent
 void term_rehash_parents(struct term *term)
 {
 	if (!term->parents)
 		return;
-	debug("rehashing parents of %lx\n", term->hash);
+	debug("rehashing parents of %lx\n", term->hash & HASH_MASK);
 
 	// we need to convert the parent hashmap to a list
 	// so we can replace the rehashed elements while looping
@@ -223,7 +228,7 @@ void term_rehash_parents(struct term *term)
 
 void term_refer_head(struct term *term, size_t depth)
 {
-	debug("referring head of %lx\n", term->hash);
+	debug("referring head of %lx\n", term->hash & HASH_MASK);
 	term->refs++;
 	if (depth < term->depth) // lower depths are more important
 		term->depth = depth;
@@ -243,7 +248,7 @@ void term_refer(struct term *term, size_t depth)
 
 char term_deref_head(struct term *term, char destroy_parents)
 {
-	debug("dereferring head of %lx\n", term->hash);
+	debug("dereferring head of %lx\n", term->hash & HASH_MASK);
 
 	assert(term->refs);
 	term->refs--;
diff --git a/test/inc.blc b/test/inc.blc
new file mode 100644
index 0000000..9cd3419
--- /dev/null
+++ b/test/inc.blc
@@ -0,0 +1 @@
+0001000011000110