More parenting

10 files changed, 148 insertions, 39 deletions

diff --git a/inc/map.h b/inc/map.h
index b389bfa..c66f850 100644
--- a/inc/map.h
+++ b/inc/map.h
@@ -10,7 +10,7 @@
 
 struct hashmap *map_all_terms(void);
 struct term *map_get(struct hashmap *map, hash_t hash);
-void map_set(struct hashmap *map, struct term *term, hash_t hash);
+void map_set(struct hashmap *map, struct term *term);
 void map_delete(struct hashmap *map, struct term *term);
 void map_initialize(void);
 void map_destroy(struct hashmap *map);
diff --git a/inc/reduce.h b/inc/reduce.h
index 4fff82f..9856075 100644
--- a/inc/reduce.h
+++ b/inc/reduce.h
@@ -6,6 +6,6 @@
 
 #include <term.h>
 
-void reduce(struct term *term);
+struct term *reduce(struct term *term);
 
 #endif
diff --git a/inc/term.h b/inc/term.h
index 3216e4a..019fa82 100644
--- a/inc/term.h
+++ b/inc/term.h
@@ -30,10 +30,12 @@ struct term {
 };
 
 struct term *term_new(term_type_t type, hash_t hash, size_t depth);
+void term_rehash_parents(struct term *term);
+struct term *term_rehash(struct term *term);
 struct term *term_rehash_abs(struct term *head, struct term *term);
 struct term *term_rehash_app(struct term *head, struct term *lhs,
 			     struct term *rhs);
-
+struct term *term_rehash_var(struct term *head, size_t index);
 void term_refer_head(struct term *term, size_t depth);
 void term_refer(struct term *term, size_t depth);
 void term_deref_head(struct term *term);
diff --git a/makefile b/makefile
index 7391b3e..98f26dd 100644
--- a/makefile
+++ b/makefile
@@ -12,7 +12,7 @@ OBJS = $(patsubst $(SRC)/%.c, $(BUILD)/%.o, $(SRCS))
 
 CFLAGS_DEBUG = -Wno-error -g -O0 -Wno-unused -fsanitize=address,undefined,leak
 CFLAGS_WARNINGS = -Wall -Wextra -Wshadow -Wpointer-arith -Wwrite-strings -Wredundant-decls -Wnested-externs -Wmissing-declarations -Wstrict-prototypes -Wmissing-prototypes -Wcast-qual -Wswitch-default -Wswitch-enum -Wunreachable-code -Wundef -Wold-style-definition -pedantic -Wno-switch-enum -Wframe-larger-than=512 -Wstack-usage=1024
-CFLAGS = $(CFLAGS_WARNINGS) -std=c99 -Ofast -I$(INC)
+CFLAGS = $(CFLAGS_WARNINGS) -std=c99 -Ofast -I$(INC) -lm
 
 ifdef DEBUG # TODO: Somehow clean automagically
 CFLAGS += $(CFLAGS_DEBUG)
diff --git a/readme.md b/readme.md
index b97f000..3d4349f 100644
--- a/readme.md
+++ b/readme.md
@@ -2,11 +2,19 @@
 
 > **c**alm **a**bstract **l**ambda **m**achine
 
-- aggressive multi-threaded reduction of lambda calculus expressions
-- small memory footprint
+- aggressive reduction of lambda calculus expressions
+- small memory footprint without leaks
+- uses [hash-based shared
+  λ-graphs](https://text.marvinborner.de/2023-05-30-16.html)
+- reducer of [larsux](https://github.com/marvinborner/larsux)
 
 ## Note
 
+The used reduction strategy works best if the reducer and scheduler
+support parallel execution using multi-threading. While planned for the
+future, this is currently not implemented due to quite a lot additional
+complexity.
+
 This repository also contains an implementation of the RKNL abstract
 machine. You can find it in the `rknl` branch.
 
diff --git a/src/main.c b/src/main.c
index af1b164..a2a5105 100644
--- a/src/main.c
+++ b/src/main.c
@@ -60,9 +60,9 @@ int main(int argc, char *argv[])
 
 	term_print(handle.term);
 	fprintf(stderr, "\n");
-	reduce(handle.term->u.abs.term);
+	struct term *reduced = reduce(handle.term->u.abs.term);
 	fprintf(stderr, "after\n");
-	term_print(handle.term);
+	term_print(reduced);
 	fprintf(stderr, "\n");
 
 	map_dump(map_all_terms());
diff --git a/src/map.c b/src/map.c
index 57394ee..16518e2 100644
--- a/src/map.c
+++ b/src/map.c
@@ -28,9 +28,9 @@ struct term *map_get(struct hashmap *map, hash_t hash)
 	return *handle;
 }
 
-void map_set(struct hashmap *map, struct term *term, hash_t hash)
+void map_set(struct hashmap *map, struct term *term)
 {
-	hashmap_set(map, &term, hash);
+	hashmap_set(map, &term, term->hash);
 }
 
 void map_initialize(void)
@@ -55,9 +55,18 @@ void map_dump(struct hashmap *map)
 	void *iter_val;
 	while (hashmap_iter(map, &iter, &iter_val)) {
 		struct term *term = *(struct term **)iter_val;
-		fprintf(stderr, "%d ", term->type);
+		fprintf(stderr, "%d\t%ld\t", term->type, term->refs);
 		term_print(term);
-		fprintf(stderr, " %ld\n", term->refs);
+		fprintf(stderr, "\t{");
+
+		size_t jiter = 0;
+		void *jiter_val;
+		while (hashmap_iter(term->parents, &jiter, &jiter_val)) {
+			struct term *parent = *(struct term **)jiter_val;
+			term_print(parent);
+			fprintf(stderr, ", ");
+		}
+		fprintf(stderr, "}\n");
 	}
 	fprintf(stderr, "---\n\n");
 }
diff --git a/src/parse.c b/src/parse.c
index d25034e..e2d2498 100644
--- a/src/parse.c
+++ b/src/parse.c
@@ -22,10 +22,11 @@ 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;
-		map_set(map_all_terms(), res_term, res);
+		// TODO: remove hash from map_set (already in term anyway)
+		map_set(map_all_terms(), res_term);
 	}
 
-	map_set(res_term->u.abs.term->parents, res_term, res_term->hash);
+	map_set(res_term->u.abs.term->parents, res_term);
 	return (struct term_handle){ .term = res_term, .hash = res };
 }
 
@@ -45,11 +46,11 @@ static struct term_handle app_blc(char **term, size_t depth)
 		res_term = term_new(res_type, res, depth);
 		res_term->u.app.lhs = lhs.term;
 		res_term->u.app.rhs = rhs.term;
-		map_set(map_all_terms(), res_term, res);
+		map_set(map_all_terms(), res_term);
 	}
 
-	map_set(res_term->u.app.lhs->parents, res_term, res_term->hash);
-	map_set(res_term->u.app.rhs->parents, res_term, res_term->hash);
+	map_set(res_term->u.app.lhs->parents, res_term);
+	map_set(res_term->u.app.rhs->parents, res_term);
 
 	return (struct term_handle){ .term = res_term, .hash = res };
 }
@@ -65,7 +66,7 @@ static struct term_handle var_blc(int index, size_t depth)
 	} else {
 		res_term = term_new(res_type, res, depth);
 		res_term->u.var.index = index;
-		map_set(map_all_terms(), res_term, res);
+		map_set(map_all_terms(), res_term);
 	}
 
 	return (struct term_handle){ .term = res_term, .hash = res };
diff --git a/src/reduce.c b/src/reduce.c
index 1cfb520..aa17655 100644
--- a/src/reduce.c
+++ b/src/reduce.c
@@ -11,42 +11,48 @@
 static struct term *substitute(struct term *term, struct term *substitution,
 			       size_t level)
 {
-	if (term->type == VAR && term->u.var.index == level) {
-		return substitution;
+	/* fprintf(stderr, "substitute: "); */
+	/* term_print(term); */
+	/* fprintf(stderr, " with "); */
+	/* term_print(substitution); */
+	/* fprintf(stderr, " at level %ld\n", level); */
+
+	if (term->type == VAR) {
+		if (term->u.var.index == level) {
+			// TODO: deref index
+			return substitution;
+		} else {
+			return term;
+		}
 	} else if (term->type == ABS) {
 		struct term *new =
 			substitute(term->u.abs.term, substitution, level + 1);
-		if (term->u.abs.term->hash == substitution->hash)
-			return term;
-		/* term_deref(term->u.abs.term); */
+		if (term->u.abs.term->hash == new->hash)
+			return term; // nothing changed
 		struct term *rehashed = term_rehash_abs(term, new);
-		/* term_deref_head(term); */
+		term_rehash_parents(rehashed);
 		return rehashed;
 	} else if (term->type == APP) {
 		struct term *lhs =
 			substitute(term->u.app.lhs, substitution, level);
 		struct term *rhs =
 			substitute(term->u.app.rhs, substitution, level);
-		if (term->u.app.lhs->hash == substitution->hash &&
-		    term->u.app.rhs->hash == substitution->hash)
-			return term;
-		/* if (term->u.app.lhs->hash != substitution->hash) */
-		/* 	term_deref(term->u.app.lhs); */
-		/* if (term->u.app.rhs->hash != substitution->hash) */
-		/* 	term_deref(term->u.app.rhs); */
+		if (term->u.app.lhs->hash == lhs->hash &&
+		    term->u.app.rhs->hash == rhs->hash)
+			return term; // nothing changed
 		struct term *rehashed = term_rehash_app(term, lhs, rhs);
-		/* term_deref_head(term); */
+		term_rehash_parents(rehashed);
 		return rehashed;
 	}
 	fatal("invalid type %d\n", term->type);
 }
 
 // reduction of application
-// ([X],Y) -> X/Y
-void reduce(struct term *term)
+// ([X] Y) -> X/Y
+struct term *reduce(struct term *term)
 {
 	assert(term->type == APP);
 	assert(term->u.app.lhs->type == ABS);
 
-	substitute(term->u.app.lhs->u.abs.term, term->u.app.rhs, 0);
+	return substitute(term->u.app.lhs, term->u.app.rhs, -1);
 }
diff --git a/src/term.c b/src/term.c
index a240312..0982f5c 100644
--- a/src/term.c
+++ b/src/term.c
@@ -50,7 +50,8 @@ struct term *term_rehash_abs(struct term *head, struct term *term)
 	hash_t res =
 		hash((uint8_t *)&head->type, sizeof(head->type), term->hash);
 
-	assert(res != head->hash);
+	if (res == head->hash)
+		return head;
 
 	struct term *match = map_get(map_all_terms(), res);
 	if (match) { // already exists
@@ -58,7 +59,8 @@ struct term *term_rehash_abs(struct term *head, struct term *term)
 	} else { // create new
 		struct term *new = term_new(ABS, res, head->depth);
 		new->u.abs.term = term;
-		map_set(map_all_terms(), new, res);
+		map_set(map_all_terms(), new);
+		map_set(term->parents, new);
 		return new;
 	}
 }
@@ -70,7 +72,8 @@ struct term *term_rehash_app(struct term *head, struct term *lhs,
 		hash((uint8_t *)&head->type, sizeof(head->type), lhs->hash);
 	res = hash((uint8_t *)&res, sizeof(res), rhs->hash);
 
-	assert(res != head->hash);
+	if (res == head->hash)
+		return head;
 
 	struct term *match = map_get(map_all_terms(), res);
 	if (match) { // already exists
@@ -79,11 +82,91 @@ struct term *term_rehash_app(struct term *head, struct term *lhs,
 		struct term *new = term_new(APP, res, head->depth);
 		new->u.app.lhs = lhs;
 		new->u.app.rhs = rhs;
-		map_set(map_all_terms(), new, res);
+		map_set(map_all_terms(), new);
+		map_set(lhs->parents, new);
+		map_set(rhs->parents, new);
 		return new;
 	}
 }
 
+struct term *term_rehash_var(struct term *head, size_t index)
+{
+	hash_t res = hash((uint8_t *)&head->type, sizeof(head->type), index);
+
+	if (res == head->hash)
+		return head;
+
+	struct term *match = map_get(map_all_terms(), res);
+	if (match) { // already exists
+		return match;
+	} else { // create new
+		struct term *new = term_new(APP, res, head->depth);
+		new->u.var.index = index;
+		map_set(map_all_terms(), new);
+		return new;
+	}
+}
+
+struct term *term_rehash(struct term *term)
+{
+	if (term->type == ABS) {
+		return term_rehash_abs(term, term->u.abs.term);
+	} else if (term->type == APP) {
+		return term_rehash_app(term, term->u.app.lhs, term->u.app.rhs);
+	} else if (term->type == VAR) {
+		return term_rehash_var(term, term->u.var.index);
+	}
+	return term;
+}
+
+// returns the direct parent
+void term_rehash_parents(struct term *term)
+{
+	if (!term->parents)
+		return;
+
+	// we need to convert the parent hashmap to a list
+	// so we can replace the rehashed elements while looping
+	// TODO: Abstract list lib?
+	struct parent_list {
+		struct term *term;
+		struct parent_list *next;
+	};
+	struct parent_list *parents = calloc(sizeof(*parents), 1);
+
+	size_t iter = 0;
+	void *iter_val;
+	while (hashmap_iter(term->parents, &iter, &iter_val)) {
+		struct parent_list *new = malloc(sizeof(*parents));
+		new->term = *(struct term **)iter_val;
+		new->next = parents;
+		parents = new;
+	}
+
+	fprintf(stderr, "NEW\n");
+	struct parent_list *iterator = parents;
+	while (iterator && iterator->term) {
+		fprintf(stderr, "rehashing parent\n");
+		struct term *parent = iterator->term;
+		hash_t previous = parent->hash;
+		struct term *new = term_rehash(parent);
+		if (previous == new->hash) {
+			struct parent_list *next = iterator->next;
+			free(iterator);
+			iterator = next;
+		}
+
+		map_delete(term->parents, parent);
+		map_set(term->parents, new);
+
+		term_rehash_parents(new);
+
+		struct parent_list *next = iterator->next;
+		free(iterator);
+		iterator = next;
+	}
+}
+
 void term_refer_head(struct term *term, size_t depth)
 {
 	term->refs++;