diff options
-rw-r--r-- | dat.h | 14 | ||||
-rw-r--r-- | eval.c | 106 | ||||
-rw-r--r-- | mkfile | 3 | ||||
-rw-r--r-- | module.c | 46 | ||||
-rw-r--r-- | parser.c | 2 | ||||
-rw-r--r-- | stdlib.pl | 1 |
6 files changed, 131 insertions, 41 deletions
@@ -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; }; @@ -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 @@ -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 + @@ -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 @@ -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 +} @@ -128,3 +128,4 @@ write_canonical(Term) :- write_canonical(S, Term) :- write_term(S, Term, [quoted(true), ignore_ops(true)]). + |