shithub: pprolog

Info  •  Files  •  Log

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

--- /dev/null

+++ b/builtins.c

@@ -1,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

--- 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

 {

@@ -21,6 +24,20 @@

 	uvlong nr; /* Unique number for each clause. Every time a clause is used, it gets a new number. */

 	Term *value;

 	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 {

--- a/eval.c

+++ b/eval.c

@@ -4,22 +4,6 @@

 #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 **);

@@ -26,6 +10,7 @@

 int equalterms(Term *, Term *);

 void applybinding(Term *, Binding *);

 Goal *copygoals(Goal *);

+Builtin findbuiltin(Term *);

 static uvlong clausenr;

@@ -63,43 +48,55 @@

 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;

-			goto Retry;

+		/* 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 != 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;

--- a/example.pl

+++ b/example.pl

@@ -5,8 +5,6 @@

 parentest :-

 	(0 * (1 + 2) * 3) * 3 + 4.

-true.

-

 likes(bob, ice).

 likes(sam, text).

 likes(sam, ice).

@@ -20,6 +18,9 @@

 list2(A) :- A = [a,b|c].

 curly(A) :- A = {one,two,three}.

+

+tester(A, B) :- !, A = B.

+tester(A, B) :- true.

 =(A,A).

--- a/fns.h

+++ b/fns.h

@@ -17,4 +17,7 @@

 int evalquery(Term *, Term *, Binding **);

 /* repl.c */

-void repl(Term *);

\ No newline at end of file

+void repl(Term *);

+

+/* builtins.c */

+Builtin findbuiltin(Term *);

--- 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