shithub: pprolog

--- a/builtins.c

+++ b/builtins.c

@@ -24,6 +24,8 @@

 BuiltinProto(builtinarg);

 BuiltinProto(builtinuniv);

 BuiltinProto(builtinis);

+BuiltinProto(builtincatch);

+BuiltinProto(builtinthrow);

 int compareterms(Term *, Term *);

@@ -81,6 +83,10 @@

 		return builtinuniv;

 	if(Match(L"is", 2))

 		return builtinis;

+	if(Match(L"catch", 3))

+		return builtincatch;

+	if(Match(L"throw", 1))

+		return builtinthrow;

 	return nil;

@@ -105,6 +111,7 @@

 	Goal *g = malloc(sizeof(Goal));

 	g->goal = goal->children;

+	g->catcher = nil;

 	g->next = *goals;

 	*goals = g;

@@ -484,4 +491,72 @@

 		return unify(result, realresult, bindings);

 	else

 		return 0;

+}

+int

+builtincatch(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)

+{

+	USED(database);

+	USED(choicestack);

+	USED(bindings);

+	Term *catchgoal = goal->children;

+	Term *catcher = catchgoal->next;

+	Term *recover = catcher->next;

+	Goal *catchframe = malloc(sizeof(Goal));

+	catchframe->goal = recover;

+	catchframe->catcher = catcher;

+	catchframe->next = *goals;

+	*goals = catchframe;

+	Goal *g = malloc(sizeof(Goal));

+	g->goal = catchgoal;

+	g->catcher = nil;

+	g->next = *goals;

+	*goals = g;

+	return 1;

+}

+int

+builtinthrow(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)

+{

+	USED(database);

+	USED(choicestack);

+	USED(bindings);

+	USED(goals);

+	Term *ball = goal->children;

+	print("Throwing: %S\n", prettyprint(ball));

+	Goal *g;

+	for(g = *goals; g != nil; g = g->next){

+		if(g->catcher == nil)

+			continue;

+		if(unify(g->catcher, ball, bindings)){

+			if(g->goal == nil){

+				/* As soon as we have print facilities as builtins, we can avoid this by having the protector frame have a unhandled exception handler*/

+				print("Unhandled exception: %S\n", prettyprint(ball));

+				exits("exception");

+				return 0;

+			}else{

+				*goals = g->next;

+				Goal *newgoal = malloc(sizeof(Goal));

+				newgoal->goal = copyterm(g->goal, nil);

+				newgoal->catcher = nil;

+				newgoal->next = *goals;

+				*goals = newgoal;

+				applybinding(newgoal->goal, *bindings);

+				Choicepoint *cp = *choicestack;

+				while(cp != nil && cp->id >= goal->clausenr)

+					cp = cp->next;

+				*choicestack = cp;

+				return 1;

+			}

+		}

+	}

+	return 0;

\ No newline at end of file

--- a/dat.h

+++ b/dat.h

@@ -29,6 +29,7 @@

 struct Goal

 	Term *goal;

+	Term *catcher; /* When this is non-nil, the goal is a catch frame, goal is the recovery. */

 	Goal *next;

};

--- a/eval.c

+++ b/eval.c

@@ -7,7 +7,6 @@

 Goal *addgoals(Goal *, Term *);

 Term *findclause(Term *, Term *, Binding **);

 int equalterms(Term *, Term *);

-void applybinding(Term *, Binding *);

 Goal *copygoals(Goal *);

 Builtin findbuiltin(Term *);

@@ -21,7 +20,7 @@

 	if(choicestack == nil){

/*

-		The goal stack has the original query at the very bottom, protected by a goal there the ->goal field is nil.

+		The goal stack has the original query at the very bottom, protected by a catch frame where the ->goal field is nil.

 		This makes it so that we can continue until we hit the protective goal, at which point we have solved everything

 		and to get the result we can unify the original query with the one at the bottom of the stack, to get the bindings

 		applied.

@@ -28,9 +27,11 @@

*/

 		goals = malloc(sizeof(Goal));

 		goals->goal = copyterm(query, nil);

+		goals->catcher = nil;

 		goals->next = nil;

 		Goal *protector = malloc(sizeof(Goal));

 		protector->goal = nil;

+		protector->catcher = mkvariable(L"catch-var");

 		protector->next = goals;

 		goals = protector;

@@ -50,6 +51,11 @@

 Retry:

 		goal = goals->goal;

+		if(goals->catcher){

+			goals = goals->next;

+			continue;

+		}

 		if(debug)

 			print("Working goal: %S\n", prettyprint(goal));

@@ -81,7 +87,6 @@

 					return 0;

 				if(debug)

 					print("Backtracking..\n");

 				Choicepoint *cp = choicestack;

 				choicestack = cp->next;

 				/* freegoals(goals) */

@@ -93,10 +98,10 @@

 		goals = goals->next;

-		/* Apply bindings to all goals on the stack. */

+		/* Apply bindings to all goals on the stack except catchframes */

 		Goal *g;

 		for(g = goals; g != nil; g = g->next){

-			if(g->goal != nil)

+			if(g->goal != nil && g->catcher == nil)

 				applybinding(g->goal, bindings);

@@ -122,6 +127,7 @@

 	}else{

 		Goal *g = malloc(sizeof(Goal));

 		g->goal = t;

+		g->catcher = nil;

 		g->next = goals;

 		goals = g;

@@ -266,6 +272,10 @@

 			g->goal = copyterm(goals->goal, nil);

 		else

 			g->goal = nil;

+		if(goals->catcher)

+			g->catcher = copyterm(goals->catcher, nil);

+		else

+			g->catcher = nil;

 		g->next = copygoals(goals->next);

 		return g;

 	}else

--- a/example.pl

+++ b/example.pl

@@ -22,3 +22,16 @@

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

 tester(A, B) :- true.

+thrower(_, 10).

+thrower(_, 20).

+thrower(inner, _) :- throw(number(30)).

+thrower(outer, _) :- throw(hehe).

+thrower(_, 100).

+throwtest(Type, L) :-

+	catch(

+		catch((thrower(Type, N), L=N), number(N), L=N),

+		Other,

+		L=outer_exception(Other)

+	).

--- a/fns.h

+++ b/fns.h

@@ -17,6 +17,7 @@

 /* eval.c */

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

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

+void applybinding(Term *, Binding *);

 /* repl.c */

 void repl(Term *);

--- a/stdlib.pl

+++ b/stdlib.pl

@@ -26,6 +26,8 @@

 _ ; Else :-

 	Else.

+A , B :- A , B.

 % Term unification

 A = A.