summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dat.h14
-rw-r--r--eval.c106
-rw-r--r--mkfile3
-rw-r--r--module.c46
-rw-r--r--parser.c2
-rw-r--r--stdlib.pl1
6 files changed, 131 insertions, 41 deletions
diff --git a/dat.h b/dat.h
index 484387b..783a785 100644
--- a/dat.h
+++ b/dat.h
@@ -3,6 +3,7 @@ typedef struct Binding Binding;
typedef struct Goal Goal;
typedef struct Choicepoint Choicepoint;
typedef struct Clause Clause;
+typedef struct Predicate Predicate;
typedef struct Module Module;
typedef int (*Builtin)(Term *, Binding **);
@@ -37,7 +38,8 @@ struct Goal
struct Choicepoint
{
Goal *goalstack;
- Clause *retryclause;
+ Clause *alternative;
+ Binding *altbindings;
uvlong id; /* Unique number for each clause. Used to know where to cut to. */
Module *currentmodule;
Choicepoint *next;
@@ -52,11 +54,19 @@ struct Clause
Clause *next;
};
+struct Predicate
+{
+ Rune *name;
+ int arity;
+ Clause *clauses;
+ Predicate *next;
+};
+
struct Module
{
/* What about imports */
Rune *name;
- Clause *clauses;
+ Predicate *predicates;
Module *next;
};
diff --git a/eval.c b/eval.c
index e0d7286..e42439f 100644
--- a/eval.c
+++ b/eval.c
@@ -6,10 +6,12 @@
#include "fns.h"
Goal *addgoals(Goal *, Term *);
+Predicate *findpredicate(Predicate *, Term *);
Clause *findclause(Clause *, Term *, Binding **);
int equalterms(Term *, Term *);
Goal *copygoals(Goal *);
Builtin findbuiltin(Term *);
+void addchoicepoints(Clause *, Term *, Goal *, Module *);
static uvlong clausenr;
@@ -45,23 +47,17 @@ evalquery(Term *query, Binding **resultbindings)
}
while(goalstack->goal != nil){
- Clause *startclause;
- Term *goal;
- Goal *oldgoalstack;
-
- startclause = nil; /* Where to start looking for a matching clause. Used by backtracking */
-Retry:
- goal = goalstack->goal;
- oldgoalstack = goalstack;
+ Term *goal = goalstack->goal;
+ Term *catcher = goalstack->catcher;
goalstack = goalstack->next;
- if(oldgoalstack->catcher)
+ if(catcher)
continue;
if(debug)
print("Working goal: %S\n", prettyprint(goal, 0, 0, 0));
- if(startclause == nil && goal->tag == CompoundTerm && goal->arity == 2 && runestrcmp(goal->text, L":") == 0){
+ if(goal->tag == CompoundTerm && goal->arity == 2 && runestrcmp(goal->text, L":") == 0){
Term *module = goal->children;
if(module->tag == AtomTerm){
Module *m = getmodule(module->text);
@@ -70,16 +66,11 @@ Retry:
else{
goal = module->next;
currentmodule = m;
- startclause = m->clauses;
- oldgoalstack->goal = goal;
}
}else
goal = typeerror(L"module", module);
}
- if(startclause == nil)
- startclause = currentmodule->clauses;
-
Binding *bindings = nil;
Clause *clause = nil;
@@ -90,20 +81,17 @@ Retry:
if(!success)
goto Backtrack;
}else{
+ Predicate *pred = findpredicate(currentmodule->predicates, goal);
+ if(pred == nil){
+ print("No predicate matches: %S\n", prettyprint(goal, 0, 0, 0));
+ goto Backtrack;
+ }
+
/* Find a clause where the head unifies with the goal */
- clause = findclause(startclause, 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(oldgoalstack);
- cp->next = choicestack;
- cp->retryclause = clause->next;
- cp->id = clause->clausenr;
- cp->currentmodule = currentmodule;
- choicestack = cp;
- }
- }else{
+ clause = findclause(pred->clauses, goal, &bindings);
+ if(clause != nil)
+ addchoicepoints(clause, goal, goalstack, currentmodule);
+ else{
Backtrack:
if(choicestack == nil)
return 0;
@@ -111,11 +99,10 @@ Backtrack:
print("Backtracking..\n");
Choicepoint *cp = choicestack;
choicestack = cp->next;
- /* freegoals(goals) */
goalstack = cp->goalstack;
currentmodule = cp->currentmodule;
- startclause = cp->retryclause;
- goto Retry;
+ clause = cp->alternative;
+ bindings = cp->altbindings;
}
}
@@ -171,6 +158,26 @@ findclause(Clause *clauses, Term *goal, Binding **bindings)
return nil;
}
+Predicate *
+findpredicate(Predicate *preds, Term *goal)
+{
+ Rune *name;
+ int arity;
+
+ name = goal->text;
+ if(goal->tag == AtomTerm)
+ arity = 0;
+ else
+ arity = goal->arity;
+
+ Predicate *p;
+ for(p = preds; p != nil; p = p->next){
+ if(runestrcmp(p->name, name) == 0 && p->arity == arity)
+ return p;
+ }
+ return nil;
+}
+
int
unify(Term *a, Term *b, Binding **bindings)
{
@@ -293,3 +300,40 @@ copygoals(Goal *goals)
}else
return nil;
}
+
+void
+addchoicepoints(Clause *clause, Term *goal, Goal *goals, Module *mod){
+ /* Find all alternative clauses that would have matched, and create a choicepoint for them */
+ Choicepoint *cps = nil;
+ Choicepoint *last = nil;
+
+ Clause *alt = clause->next;
+ while(alt != nil){
+ Binding *altbindings = nil;
+ clause = findclause(alt, goal, &altbindings);
+ if(clause){
+ /* Add choicepoint here */
+ Choicepoint *cp = malloc(sizeof(Choicepoint));
+ cp->goalstack = copygoals(goals);
+ cp->next = nil;
+ cp->alternative = clause;
+ cp->altbindings = altbindings;
+ cp->id = clause->clausenr;
+ cp->currentmodule = mod;
+ if(cps == nil){
+ cps = cp;
+ last = cp;
+ }else{
+ last->next = cp;
+ last = cp;
+ }
+ alt = clause->next;
+ }else
+ alt = nil;
+ }
+
+ if(last){
+ last->next = choicestack;
+ choicestack = cps;
+ }
+} \ No newline at end of file
diff --git a/mkfile b/mkfile
index ff71738..ef5d2b0 100644
--- a/mkfile
+++ b/mkfile
@@ -19,4 +19,5 @@ HFILES=dat.h fns.h
BIN=/$objtype/bin
-</sys/src/cmd/mkone \ No newline at end of file
+</sys/src/cmd/mkone
+
diff --git a/module.c b/module.c
index f3ab01b..f1fb4f2 100644
--- a/module.c
+++ b/module.c
@@ -7,6 +7,7 @@
Module *addemptymodule(Rune *);
Clause *appendclause(Clause *, Clause *);
+Predicate *appendpredicate(Predicate *, Predicate *);
void
initmodules(void)
@@ -52,9 +53,11 @@ parsemodule(char *file)
terms = terms->next;
}
+ Predicate *currentpred = nil;
Term *t;
for(t = terms; t != nil; t = t->next){
Clause *cl = malloc(sizeof(Clause));
+ int arity;
cl->clausenr = 0;
cl->public = 1; /* everything is public for now */
cl->next = nil;
@@ -65,12 +68,29 @@ parsemodule(char *file)
cl->head = t;
cl->body = nil;
}
-
- if(m == nil)
- usermodule->clauses = appendclause(usermodule->clauses, cl);
+ if(cl->head->tag == AtomTerm)
+ arity = 0;
else
- m->clauses = appendclause(m->clauses, cl);
+ arity = cl->head->arity;
+
+ /* Figure out if this clause goes into the latest predicate, or if it is the start of a new one */
+ if(currentpred == nil || runestrcmp(cl->head->text, currentpred->name) != 0 || arity != currentpred->arity){
+ if(m)
+ m->predicates = appendpredicate(currentpred, m->predicates);
+ else
+ usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);
+ currentpred = malloc(sizeof(Predicate));
+ currentpred->name = cl->head->text;
+ currentpred->arity = arity;
+ currentpred->clauses = cl;
+ currentpred->next = nil;
+ }else
+ currentpred->clauses = appendclause(currentpred->clauses, cl);
}
+ if(m)
+ m->predicates = appendpredicate(currentpred, m->predicates);
+ else
+ usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);
return m;
}
@@ -94,9 +114,9 @@ addemptymodule(Rune *name)
m->next = modules;
if(systemmodule == nil)
- m->clauses = nil;
+ m->predicates = nil;
else
- m->clauses = systemmodule->clauses; /* Direct access to system clauses for now, but when I figure out imports this will change */
+ m->predicates = systemmodule->predicates; /* Direct access to system clauses for now, but when I figure out imports this will change */
modules = m;
return m;
}
@@ -113,4 +133,18 @@ appendclause(Clause *clauses, Clause *new)
tmp->next = new;
return clauses;
+}
+
+Predicate *
+appendpredicate(Predicate *preds, Predicate *new)
+{
+ Predicate *tmp;
+
+ if(preds == nil)
+ return new;
+
+ for(tmp = preds; tmp->next != nil; tmp = tmp->next);
+
+ tmp->next = new;
+ return preds;
} \ No newline at end of file
diff --git a/parser.c b/parser.c
index 0acf3b6..172475e 100644
--- a/parser.c
+++ b/parser.c
@@ -660,4 +660,4 @@ syntaxerror_parser(char *where)
{
print("Syntax error: Unexpected %d (%S) token in %s\n", lookahead.tag, lookahead.text, where);
exits("syntax error");
-} \ No newline at end of file
+}
diff --git a/stdlib.pl b/stdlib.pl
index 4a62f87..596aff6 100644
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -128,3 +128,4 @@ write_canonical(Term) :-
write_canonical(S, Term) :-
write_term(S, Term, [quoted(true), ignore_ops(true)]).
+