From 0c45e33c1b8d094353a5585c44179d1818ff6e1e Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Tue, 6 Jul 2021 17:45:15 +0000
Subject: 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.

---
 eval.c | 106 ++++++++++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 75 insertions(+), 31 deletions(-)

(limited to 'eval.c')

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
-- 
cgit v1.2.3