From e5ab41faf611c61878ad792cbaaf0294cd5715dd Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Thu, 1 Jul 2021 19:55:40 +0000 Subject: Add exceptions :) implement catch/3 and throw/1 --- builtins.c | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ dat.h | 1 + eval.c | 20 ++++++++++++----- example.pl | 13 +++++++++++ fns.h | 1 + stdlib.pl | 2 ++ 6 files changed, 107 insertions(+), 5 deletions(-) diff --git a/builtins.c b/builtins.c index 4a2161f..cbb01e6 100644 --- a/builtins.c +++ b/builtins.c @@ -24,6 +24,8 @@ BuiltinProto(builtinfunctor); BuiltinProto(builtinarg); BuiltinProto(builtinuniv); BuiltinProto(builtinis); +BuiltinProto(builtincatch); +BuiltinProto(builtinthrow); int compareterms(Term *, Term *); @@ -81,6 +83,10 @@ findbuiltin(Term *goal) 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 @@ builtincall(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Goal *g = malloc(sizeof(Goal)); g->goal = goal->children; + g->catcher = nil; g->next = *goals; *goals = g; @@ -484,4 +491,72 @@ builtinis(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, B 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 diff --git a/dat.h b/dat.h index 2cf28b7..ce6a0df 100644 --- a/dat.h +++ b/dat.h @@ -29,6 +29,7 @@ struct Binding struct Goal { Term *goal; + Term *catcher; /* When this is non-nil, the goal is a catch frame, goal is the recovery. */ Goal *next; }; diff --git a/eval.c b/eval.c index e28e5e6..ae34175 100644 --- 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,16 +20,18 @@ evalquery(Term *database, Term *query, Binding **resultbindings, Choicepoint **r 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. */ 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 @@ evalquery(Term *database, Term *query, Binding **resultbindings, Choicepoint **r Retry: goal = goals->goal; + if(goals->catcher){ + goals = goals->next; + continue; + } + if(debug) print("Working goal: %S\n", prettyprint(goal)); @@ -81,7 +87,6 @@ Backtrack: return 0; if(debug) print("Backtracking..\n"); - Choicepoint *cp = choicestack; choicestack = cp->next; /* freegoals(goals) */ @@ -93,10 +98,10 @@ Backtrack: 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 @@ addgoals(Goal *goals, Term *t) }else{ Goal *g = malloc(sizeof(Goal)); g->goal = t; + g->catcher = nil; g->next = goals; goals = g; } @@ -266,6 +272,10 @@ copygoals(Goal *goals) 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 diff --git a/example.pl b/example.pl index c2c8335..6633ff0 100644 --- a/example.pl +++ b/example.pl @@ -22,3 +22,16 @@ curly(A) :- A = {one,two,three}. 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) + ). diff --git a/fns.h b/fns.h index aea1ba8..4e3afd2 100644 --- a/fns.h +++ b/fns.h @@ -17,6 +17,7 @@ Term *mkstring(Rune *); /* eval.c */ int evalquery(Term *, Term *, Binding **, Choicepoint **); int unify(Term *, Term *, Binding **); +void applybinding(Term *, Binding *); /* repl.c */ void repl(Term *); diff --git a/stdlib.pl b/stdlib.pl index cceada6..f67a4a4 100644 --- a/stdlib.pl +++ b/stdlib.pl @@ -26,6 +26,8 @@ If ; _ :- _ ; Else :- Else. +A , B :- A , B. + % Term unification A = A. -- cgit v1.2.3