Add support for builtins, and implement true/0, fail/0, call/1, and !/0 builtins

6 files changed, 163 insertions, 53 deletions

diff --git a/builtins.c b/builtins.c
new file mode 100644
index 0000000..5db5e62
--- /dev/null
+++ b/builtins.c
@@ -0,0 +1,92 @@
+#include <u.h>
+#include <libc.h>
+
+#include "dat.h"
+#include "fns.h"
+
+int builtintrue(Term *, Term *, Goal **, Choicepoint **, Binding **);
+int builtinfail(Term *, Term *, Goal **, Choicepoint **, Binding **);
+int builtincall(Term *, Term *, Goal **, Choicepoint **, Binding **);
+int builtincut(Term *, Term *, Goal **, Choicepoint **, Binding **);
+
+Builtin
+findbuiltin(Term *goal)
+{
+	int arity;
+	Rune *name;
+
+	switch(goal->tag){
+	case AtomTerm:
+		arity = 0;
+		name = goal->text;
+		break;
+	case CompoundTerm:
+		arity = goal->arity;
+		name = goal->text;
+		break;
+	default:
+		return nil;
+	}
+
+	if(!runestrcmp(name, L"true") && arity == 0)
+		return builtintrue;
+	if(!runestrcmp(name, L"fail") && arity == 0)
+		return builtinfail;
+	if(!runestrcmp(name, L"call") && arity == 1)
+		return builtincall;
+	if(!runestrcmp(name, L"!") && arity == 0)
+		return builtincut;
+
+	return nil;
+}
+
+int
+builtintrue(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goal);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+	return 1;
+}
+
+int
+builtinfail(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goal);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+	return 0;
+}
+
+int
+builtincall(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(choicestack);
+	USED(bindings);
+
+	Goal *g = malloc(sizeof(Goal));
+	g->goal = goal->children;
+	g->next = *goals;
+	*goals = g;
+
+	return 1;
+}
+
+int
+builtincut(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(bindings);
+
+	Choicepoint *cp = *choicestack;
+	while(cp != nil && cp->id == goal->clausenr)
+		cp = cp->next;
+	*choicestack = cp;
+	return 1;
+}
\ No newline at end of file
diff --git a/dat.h b/dat.h
index d5dbfef..a090afb 100644
--- a/dat.h
+++ b/dat.h
@@ -1,5 +1,8 @@
 typedef struct Term Term;
 typedef struct Binding Binding;
+typedef struct Goal Goal;
+typedef struct Choicepoint Choicepoint;
+typedef int (*Builtin)(Term *, Term *, Goal **, Choicepoint **, Binding **);
 
 struct Term
 {
@@ -23,6 +26,20 @@ struct Binding
 	Binding *next;
 };
 
+struct Goal
+{
+	Term *goal;
+	Goal *next;
+};
+
+struct Choicepoint
+{
+	Goal *goalstack;
+	Term *retryclause;
+	uvlong id; /* Unique number for each clause. Used to know where to cut to. */
+	Choicepoint *next;
+};
+
 enum {
 	CompoundTerm,
 	AtomTerm,
diff --git a/eval.c b/eval.c
index 8a372a3..cf26fdf 100644
--- a/eval.c
+++ b/eval.c
@@ -4,28 +4,13 @@
 #include "dat.h"
 #include "fns.h"
 
-typedef struct Goal Goal;
-typedef struct Choicepoint Choicepoint;
-
-struct Goal
-{
-	Term *goal;
-	Goal *next;
-};
-
-struct Choicepoint
-{
-	Goal *goalstack;
-	Term *retryclause;
-	Choicepoint *next;
-};
-
 Goal *addgoals(Goal *, Term *);
 Term *findclause(Term *, Term *, Binding **);
 int unify(Term *, Term *, Binding **);
 int equalterms(Term *, Term *);
 void applybinding(Term *, Binding *);
 Goal *copygoals(Goal *);
+Builtin findbuiltin(Term *);
 
 static uvlong clausenr;
 
@@ -63,43 +48,55 @@ evalquery(Term *database, Term *query, Binding **resultbindings)
 Retry:
 		goal = goals->goal;
 
-		/* Find a clause where the head unifies with the goal */
 		Binding *bindings = nil;
-		Term *clause = findclause(dbstart, 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(goals);
-				cp->next = choicestack;
-				cp->retryclause = clause->next;
-				choicestack = cp;
-			}
-			goals = goals->next;
+		Term *clause = nil;
 
-			/* Apply bindings to all goals on the stack. */
-			Goal *g;
-			for(g = goals; g != nil; g = g->next){
-				if(g->goal != nil)
-					applybinding(g->goal, bindings);
-			}
-			
-			/* Add clause body as goals, with bindings applied */
-			if(clause->tag == CompoundTerm && clause->arity == 2 && runestrcmp(clause->text, L":-") == 0){
-				Term *subgoal = copyterm(clause->children->next, nil);
-				applybinding(subgoal, bindings);
-				goals = addgoals(goals, subgoal);
-			}
+		/* Try to see if the goal can be solved using a builtin first */
+		Builtin builtin = findbuiltin(goal);
+		if(builtin != nil){
+			int success = builtin(database, goal, &goals->next, &choicestack, &bindings);
+			if(!success)
+				goto Backtrack;
 		}else{
-			if(choicestack == nil)
-				return 0;
-			Choicepoint *cp = choicestack;
-			choicestack = cp->next;
-			/* freegoals(goals) */
-			goals = cp->goalstack;
-			dbstart = cp->retryclause;
+			/* Find a clause where the head unifies with the goal */
+			clause = findclause(dbstart, 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(goals);
+					cp->next = choicestack;
+					cp->retryclause = clause->next;
+					cp->id = clause->clausenr;
+					choicestack = cp;
+				}
+			}else{
+Backtrack:
+				if(choicestack == nil)
+					return 0;
+				Choicepoint *cp = choicestack;
+				choicestack = cp->next;
+				/* freegoals(goals) */
+				goals = cp->goalstack;
+				dbstart = cp->retryclause;
+				goto Retry;
+			}
+		}
+		
+		goals = goals->next;
+
+		/* Apply bindings to all goals on the stack. */
+		Goal *g;
+		for(g = goals; g != nil; g = g->next){
+			if(g->goal != nil)
+				applybinding(g->goal, bindings);
+		}
 
-			goto Retry;
+		/* Add clause body as goals, with bindings applied */
+		if(clause != nil && clause->tag == CompoundTerm && clause->arity == 2 && runestrcmp(clause->text, L":-") == 0){
+			Term *subgoal = copyterm(clause->children->next, nil);
+			applybinding(subgoal, bindings);
+			goals = addgoals(goals, subgoal);
 		}
 	}
 	goals = goals->next;
diff --git a/example.pl b/example.pl
index d9ffc2a..3df943c 100644
--- a/example.pl
+++ b/example.pl
@@ -5,8 +5,6 @@ parentest :-
 parentest :-
 	(0 * (1 + 2) * 3) * 3 + 4.
 
-true.
-
 likes(bob, ice).
 likes(sam, text).
 likes(sam, ice).
@@ -21,6 +19,9 @@ list2(A) :- A = [a,b|c].
 
 curly(A) :- A = {one,two,three}.
 
+tester(A, B) :- !, A = B.
+tester(A, B) :- true.
+
 =(A,A).
 
 length([], zero).
diff --git a/fns.h b/fns.h
index b8e92ca..d145b81 100644
--- a/fns.h
+++ b/fns.h
@@ -17,4 +17,7 @@ Term *mknumber(int, vlong, double);
 int evalquery(Term *, Term *, Binding **);
 
 /* repl.c */
-void repl(Term *);
\ No newline at end of file
+void repl(Term *);
+
+/* builtins.c */
+Builtin findbuiltin(Term *);
diff --git a/mkfile b/mkfile
index 5191d06..a546509 100644
--- a/mkfile
+++ b/mkfile
@@ -2,7 +2,7 @@
 
 TARG=pprolog
 
-OFILES=main.$O parser.$O eval.$O prettyprint.$O misc.$O repl.$O
+OFILES=main.$O parser.$O eval.$O builtins.$O prettyprint.$O misc.$O repl.$O
 
 HFILES=dat.h fns.h