ref: 50f83a91220940042962fdb55d07bb03991f52be
parent: 347e5bc533070a5e988d82e7588a4e905c7096f3
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Wed Jun 30 13:03:25 EDT 2021
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