Group clauses into predicates, and create all valid choicepoints at once. This is wastefull if one branch loops forever, but it is much nicer otherwise, since we know the choicepoints only gets created as long as their head is unifiable with the goal.

6 files changed, 131 insertions, 41 deletions

diff --git a/dat.h b/dat.h
index 484387b..783a785 100644
--- a/dat.h
+++ b/dat.h
@@ -3,6 +3,7 @@ typedef struct Binding Binding;
 typedef struct Goal Goal;
 typedef struct Choicepoint Choicepoint;
 typedef struct Clause Clause;
+typedef struct Predicate Predicate;
 typedef struct Module Module;
 typedef int (*Builtin)(Term *, Binding **);
 
@@ -37,7 +38,8 @@ struct Goal
 struct Choicepoint
 {
 	Goal *goalstack;
-	Clause *retryclause;
+	Clause *alternative;
+	Binding *altbindings;
 	uvlong id; /* Unique number for each clause. Used to know where to cut to. */
 	Module *currentmodule;
 	Choicepoint *next;
@@ -52,11 +54,19 @@ struct Clause
 	Clause *next;
 };
 
+struct Predicate
+{
+	Rune *name;
+	int arity;
+	Clause *clauses;
+	Predicate *next;
+};
+
 struct Module
 {
 	/* What about imports */
 	Rune *name;
-	Clause *clauses;
+	Predicate *predicates;
 	Module *next;
 };
 
diff --git a/eval.c b/eval.c
index e0d7286..e42439f 100644
--- a/eval.c
+++ b/eval.c
@@ -6,10 +6,12 @@
 #include "fns.h"
 
 Goal *addgoals(Goal *, Term *);
+Predicate *findpredicate(Predicate *, Term *);
 Clause *findclause(Clause *, Term *, Binding **);
 int equalterms(Term *, Term *);
 Goal *copygoals(Goal *);
 Builtin findbuiltin(Term *);
+void addchoicepoints(Clause *, Term *, Goal *, Module *);
 
 static uvlong clausenr;
 
@@ -45,23 +47,17 @@ evalquery(Term *query, Binding **resultbindings)
 	}
 
 	while(goalstack->goal != nil){
-		Clause *startclause;
-		Term *goal;
-		Goal *oldgoalstack;
-
-		startclause = nil; /* Where to start looking for a matching clause. Used by backtracking */
-Retry:
-		goal = goalstack->goal;
-		oldgoalstack = goalstack;
+		Term *goal = goalstack->goal;
+		Term *catcher = goalstack->catcher;
 		goalstack = goalstack->next;
 
-		if(oldgoalstack->catcher)
+		if(catcher)
 			continue;
 
 		if(debug)
 			print("Working goal: %S\n", prettyprint(goal, 0, 0, 0));
 
-		if(startclause == nil && goal->tag == CompoundTerm && goal->arity == 2 && runestrcmp(goal->text, L":") == 0){
+		if(goal->tag == CompoundTerm && goal->arity == 2 && runestrcmp(goal->text, L":") == 0){
 			Term *module = goal->children;
 			if(module->tag == AtomTerm){
 				Module *m = getmodule(module->text);
@@ -70,16 +66,11 @@ Retry:
 				else{
 					goal = module->next;
 					currentmodule = m;
-					startclause = m->clauses;
-					oldgoalstack->goal = goal;
 				}
 			}else
 				goal = typeerror(L"module", module);
 		}
 
-		if(startclause == nil)
-			startclause = currentmodule->clauses;
-
 		Binding *bindings = nil;
 		Clause *clause = nil;
 		
@@ -90,20 +81,17 @@ Retry:
 			if(!success)
 				goto Backtrack;
 		}else{
+			Predicate *pred = findpredicate(currentmodule->predicates, goal);
+			if(pred == nil){
+				print("No predicate matches: %S\n", prettyprint(goal, 0, 0, 0));
+				goto Backtrack;
+			}
+
 			/* Find a clause where the head unifies with the goal */
-			clause = findclause(startclause, goal, &bindings);
-			if(clause != nil){
-				if(clause->next != nil){
-					/* Add a choicepoint. Note we create a choicepoint every time, so there is room for improvement. */
-					Choicepoint *cp = malloc(sizeof(Choicepoint));
-					cp->goalstack = copygoals(oldgoalstack);
-					cp->next = choicestack;
-					cp->retryclause = clause->next;
-					cp->id = clause->clausenr;
-					cp->currentmodule = currentmodule;
-					choicestack = cp;
-				}
-			}else{
+			clause = findclause(pred->clauses, goal, &bindings);
+			if(clause != nil)
+				addchoicepoints(clause, goal, goalstack, currentmodule);
+			else{
 Backtrack:
 				if(choicestack == nil)
 					return 0;
@@ -111,11 +99,10 @@ Backtrack:
 					print("Backtracking..\n");
 				Choicepoint *cp = choicestack;
 				choicestack = cp->next;
-				/* freegoals(goals) */
 				goalstack = cp->goalstack;
 				currentmodule = cp->currentmodule;
-				startclause = cp->retryclause;
-				goto Retry;
+				clause = cp->alternative;
+				bindings = cp->altbindings;
 			}
 		}
 
@@ -171,6 +158,26 @@ findclause(Clause *clauses, Term *goal, Binding **bindings)
 	return nil;
 }
 
+Predicate *
+findpredicate(Predicate *preds, Term *goal)
+{
+	Rune *name;
+	int arity;
+
+	name = goal->text;
+	if(goal->tag == AtomTerm)
+		arity = 0;
+	else
+		arity = goal->arity;
+
+	Predicate *p;
+	for(p = preds; p != nil; p = p->next){
+		if(runestrcmp(p->name, name) == 0 && p->arity == arity)
+			return p;
+	}
+	return nil;
+}
+
 int
 unify(Term *a, Term *b, Binding **bindings)
 {
@@ -293,3 +300,40 @@ copygoals(Goal *goals)
 	}else
 		return nil;
 }
+
+void
+addchoicepoints(Clause *clause, Term *goal, Goal *goals, Module *mod){
+	/* Find all alternative clauses that would have matched, and create a choicepoint for them */
+	Choicepoint *cps = nil;
+	Choicepoint *last = nil;
+
+	Clause *alt = clause->next;
+	while(alt != nil){
+		Binding *altbindings = nil;
+		clause = findclause(alt, goal, &altbindings);
+		if(clause){
+			/* Add choicepoint here */
+			Choicepoint *cp = malloc(sizeof(Choicepoint));
+			cp->goalstack = copygoals(goals);
+			cp->next = nil;
+			cp->alternative = clause;
+			cp->altbindings = altbindings;
+			cp->id = clause->clausenr;
+			cp->currentmodule = mod;
+			if(cps == nil){
+				cps = cp;
+				last = cp;
+			}else{
+				last->next = cp;
+				last = cp;
+			}
+			alt = clause->next;
+		}else
+			alt = nil;
+	}
+
+	if(last){
+		last->next = choicestack;
+		choicestack = cps;
+	}
+}
\ No newline at end of file
diff --git a/mkfile b/mkfile
index ff71738..ef5d2b0 100644
--- a/mkfile
+++ b/mkfile
@@ -19,4 +19,5 @@ HFILES=dat.h fns.h
 
 BIN=/$objtype/bin
 
-</sys/src/cmd/mkone
\ No newline at end of file
+</sys/src/cmd/mkone
+
diff --git a/module.c b/module.c
index f3ab01b..f1fb4f2 100644
--- a/module.c
+++ b/module.c
@@ -7,6 +7,7 @@
 
 Module *addemptymodule(Rune *);
 Clause *appendclause(Clause *, Clause *);
+Predicate *appendpredicate(Predicate *, Predicate *);
 
 void
 initmodules(void)
@@ -52,9 +53,11 @@ parsemodule(char *file)
 		terms = terms->next;
 	}
 
+	Predicate *currentpred = nil;
 	Term *t;
 	for(t = terms; t != nil; t = t->next){
 		Clause *cl = malloc(sizeof(Clause));
+		int arity;
 		cl->clausenr = 0;
 		cl->public = 1; /* everything is public for now */
 		cl->next = nil;
@@ -65,12 +68,29 @@ parsemodule(char *file)
 			cl->head = t;
 			cl->body = nil;
 		}
-
-		if(m == nil)
-			usermodule->clauses = appendclause(usermodule->clauses, cl);
+		if(cl->head->tag == AtomTerm)
+			arity = 0;
 		else
-			m->clauses = appendclause(m->clauses, cl);
+			arity = cl->head->arity;
+
+		/* Figure out if this clause goes into the latest predicate, or if it is the start of a new one */
+		if(currentpred == nil || runestrcmp(cl->head->text, currentpred->name) != 0 || arity != currentpred->arity){
+			if(m)
+				m->predicates = appendpredicate(currentpred, m->predicates);
+			else
+				usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);
+			currentpred = malloc(sizeof(Predicate));
+			currentpred->name = cl->head->text;
+			currentpred->arity = arity;
+			currentpred->clauses = cl;
+			currentpred->next = nil;
+		}else
+			currentpred->clauses = appendclause(currentpred->clauses, cl);
 	}
+	if(m)
+		m->predicates = appendpredicate(currentpred, m->predicates);
+	else
+		usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);
 
 	return m;
 }
@@ -94,9 +114,9 @@ addemptymodule(Rune *name)
 	m->next = modules;
 
 	if(systemmodule == nil)
-		m->clauses = nil;
+		m->predicates = nil;
 	else
-		m->clauses = systemmodule->clauses; /* Direct access to system clauses for now, but when I figure out imports this will change */
+		m->predicates = systemmodule->predicates; /* Direct access to system clauses for now, but when I figure out imports this will change */
 	modules = m;
 	return m;
 }
@@ -113,4 +133,18 @@ appendclause(Clause *clauses, Clause *new)
 
 	tmp->next = new;
 	return clauses;
+}
+
+Predicate *
+appendpredicate(Predicate *preds, Predicate *new)
+{
+	Predicate *tmp;
+
+	if(preds == nil)
+		return new;
+
+	for(tmp = preds; tmp->next != nil; tmp = tmp->next);
+
+	tmp->next = new;
+	return preds;
 }
\ No newline at end of file
diff --git a/parser.c b/parser.c
index 0acf3b6..172475e 100644
--- a/parser.c
+++ b/parser.c
@@ -660,4 +660,4 @@ syntaxerror_parser(char *where)
 {
 	print("Syntax error: Unexpected %d (%S) token in %s\n", lookahead.tag, lookahead.text, where);
 	exits("syntax error");
-}
\ No newline at end of file
+}
diff --git a/stdlib.pl b/stdlib.pl
index 4a62f87..596aff6 100644
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -128,3 +128,4 @@ write_canonical(Term) :-
 
 write_canonical(S, Term) :-
 	write_term(S, Term, [quoted(true), ignore_ops(true)]).
+