shithub: pprolog

ref: 13efe91101a11f41caf6321a8b2fbdd96ef9927a
dir: /eval.c/

View raw version
#include <u.h>
#include <libc.h>
#include <bio.h>

#include "dat.h"
#include "fns.h"

int equalterms(Term *, Term *);
Goal *copygoals(Goal *);
Builtin findbuiltin(Term *);
void addchoicepoints(Clause *, Term *, Goal *, Module *);

int
evalquery(Term *query)
{
	Binding *replbindings = nil;
	goalstack = addgoals(goalstack, query, getmodule(L"user"), 0);

	while(goalstack->goal != nil){
		Term *goal = goalstack->goal;
		Term *catcher = goalstack->catcher;
		Module *module = goalstack->module;
		uvlong goalnr = goalstack->goalnr;
		goalstack = goalstack->next;

		if(catcher)
			continue;

		if(flagdebug)
			print("Working goal %ulld: %S:%S\n", goalnr, module->name, prettyprint(goal, 0, 1, 0, nil));

		if(goal->tag == VariableTerm)
			goal = instantiationerror();
		if(goal->tag != AtomTerm && goal->tag != CompoundTerm)
			goal = typeerror(L"callable", goal);

		Binding *bindings = nil;
		Clause *clause = nil;

		/* handle special cases which need to cut: !/0, throw/1 */
		if(goal->tag == AtomTerm && runestrcmp(goal->text, L"!") == 0){
			Choicepoint *cp = choicestack;
			/* Cut all choicepoints with an id larger or equal to the goal clause number,
			   since they must have been introduced
	   		   after this goal's parent.
			*/
			while(cp != nil && cp->id >= goalnr)
				cp = cp->next;
			choicestack = cp;
			continue;
		}else if(goal->tag == CompoundTerm && runestrcmp(goal->text, L"throw") == 0 && goal->arity == 1){
			Term *ball = goal->children;
			Goal *g;
			int caught = 0;
			for(g = goalstack; g != nil && !caught; g = g->next){
				if(g->catcher == nil)
					continue;

				if(unify(g->catcher, ball, &bindings)){
					goalstack = g->next;
					Goal *newgoal = gmalloc(sizeof(Goal));
					newgoal->goal = copyterm(g->goal);
					newgoal->module = g->module;
					newgoal->catcher = nil;
					newgoal->next = goalstack;
					goalstack = newgoal;
					applybinding(newgoal->goal, bindings);

					Choicepoint *cp = choicestack;
					while(cp != nil && cp->id >= goalnr)
						cp = cp->next;
					choicestack = cp;
					caught = 1;
				}
			}
			continue;
		}

		/* Try to see if the goal can be solved using a builtin first */
		Builtin builtin = findbuiltin(goal);
		if(builtin != nil){
			int success = builtin(goal, &bindings, module);
			if(!success)
				goto Backtrack;
		}else{
			Predicate *pred = findpredicate(module->predicates, goal);
			if(pred == nil){
				/* To to find it in the system module */
				Module *sysmod;
				if(systemmoduleloaded)
					sysmod = getmodule(L"system");
				else
					sysmod = getmodule(L"user");
				pred = findpredicate(sysmod->predicates, goal);
			}
			if(pred == nil){
				Rune *name;
				int arity;
				Term *replacement = nil;
				Term *procedure;
				Term *pi;
				if(goal->tag == CompoundTerm){
					name = goal->text;
					arity = goal->arity;
				}else{
					name = prettyprint(goal, 0, 0, 0, nil);
					arity = 0;
				}

				switch(flagunknown){
				case UnknownError:
					procedure = mkatom(name);
					procedure->next = mkinteger(arity);
					pi = mkcompound(L"/", 2, procedure);
					replacement = existenceerror(L"procedure", pi);
					break;
				case UnknownWarning:
					print("Warning: no such predicate in module %S: %S/%d\n", module->name, name, arity);
				case UnknownFail:
					replacement = mkatom(L"fail");
				}
				goalstack = addgoals(goalstack, replacement, module, goalnr);
				continue;
			}

			/* Find a clause where the head unifies with the goal */
			clause = findclause(pred->clauses, goal, &bindings);
			if(clause != nil)
				addchoicepoints(clause, goal, goalstack, module);
			else{
Backtrack:
				if(choicestack == nil)
					return 0;
				if(flagdebug)
					print("Backtracking..\n");
				Choicepoint *cp = choicestack;
				choicestack = cp->next;
				goalstack = cp->goalstack;
				module = cp->currentmodule;
				clause = cp->alternative;
				bindings = cp->altbindings;
			}
		}

		/* Apply bindings to all goals on the stack except catchframes */
		Goal *g;
		for(g = goalstack; g != nil; g = g->next){
			if(g->goal != nil && g->catcher == nil)
				applybinding(g->goal, bindings);
		}

		/* Add clause body as goals, with bindings applied */
		if(clause != nil && clause->body != nil){
			Term *subgoal = copyterm(clause->body);
			applybinding(subgoal, bindings);
			goalstack = addgoals(goalstack, subgoal, module, clause->clausenr);
		}
	}
	goalstack = goalstack->next;
	unify(query, goalstack->goal, &replbindings);
	return 1;
}

Goal *
addgoals(Goal *goals, Term *t, Module *module, uvlong goalnr)
{
	if(t->tag == CompoundTerm && runestrcmp(t->text, L",") == 0 && t->arity == 2){
		goals = addgoals(goals, t->children->next, module, goalnr);
		goals = addgoals(goals, t->children, module, goalnr);
	}else{
		if(t->tag == CompoundTerm && runestrcmp(t->text, L":") == 0 && t->arity == 2){
			Term *moduleterm = t->children;
			if(moduleterm->tag == AtomTerm){
				Module *m = getmodule(moduleterm->text);
				if(m == nil)
					t = existenceerror(L"module", moduleterm);
				else{
					t = moduleterm->next;
					module = m;
				}
			}else
				t = typeerror(L"module", moduleterm);
		}
		Goal *g = gmalloc(sizeof(Goal));
		g->goal = t;
		g->goalnr = goalnr;
		g->module = module;
		g->catcher = nil;
		g->next = goals;
		goals = g;
	}
	return goals;
}

Clause *
findclause(Clause *clauses, Term *goal, Binding **bindings)
{
	Clause *clause;
	for(; clauses != nil; clauses = clauses->next){
		clause = copyclause(clauses, &clausenr);
		renameclausevars(clause);
		clausenr++;
		clause->next = clauses->next;
		if(unify(clause->head, goal, bindings))
			return clause;
	}
	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)
{
	Term *leftstack;
	Term *rightstack;
	Term *left;
	Term *right;

	leftstack = copyterm(a);
	rightstack = copyterm(b);

	while(leftstack != nil && rightstack != nil){
		left = leftstack;
		leftstack = left->next;
		right = rightstack;
		rightstack = right->next;

		if(equalterms(left, right))
			continue;
		else if(left->tag == VariableTerm || right->tag == VariableTerm){
			if(left->tag != VariableTerm && right->tag == VariableTerm){
				Term *tmp = left;
				left = right;
				right = tmp;
			}
			if(left->tag == VariableTerm && right->tag == VariableTerm && right->varnr > left->varnr){
				Term *tmp = left;
				left = right;
				right = tmp;
			}

			Binding *b = gmalloc(sizeof(Binding));
			b->varnr = left->varnr;
			b->value = right;
			b->next = *bindings;
			*bindings = b;

			Term *t;
			for(t = leftstack; t != nil; t = t->next)
				applybinding(t, b);
			for(t = rightstack; t != nil; t = t->next)
				applybinding(t, b);
			Binding *tmpb;
			for(tmpb = *bindings; tmpb != nil; tmpb = tmpb->next)
				applybinding(tmpb->value, b);
		}else if(left->tag == CompoundTerm && right->tag == CompoundTerm && left->arity == right->arity && runestrcmp(left->text, right->text) == 0){
			Term *leftchild = left->children;
			Term *rightchild = right->children;
			while(leftchild != nil && rightchild != nil){
				Term *t1 = copyterm(leftchild);
				t1->next = leftstack;
				leftstack = t1;
				leftchild = leftchild->next;

				Term *t2 = copyterm(rightchild);
				t2->next = rightstack;
				rightstack = t2;
				rightchild = rightchild->next;
			}
		}else{
			*bindings = nil;
			return 0; /* failure */
		}
	}
	return 1;
}

int
equalterms(Term *a, Term *b)
{
	/* Check that two non-compound terms are identical */
	if(a->tag != b->tag)
		return 0;

	switch(a->tag){
	case AtomTerm:
		return runestrcmp(a->text, b->text) == 0;
	case VariableTerm:
		return a->varnr == b->varnr;
	case FloatTerm:
		return a->dval == b->dval;
	case IntegerTerm:
		return a->ival == b->ival;	
	default:
		return 0;
	}
}

void
applybinding(Term *t, Binding *bindings)
{
	if(t->tag == VariableTerm){
		Binding *b;
		for(b = bindings; b != nil; b = b->next){
			if(b->varnr == t->varnr){
				Term *next = t->next;
				memcpy(t, b->value, sizeof(Term));
				t->next = next;
				return;
			}
		}
	}else if(t->tag == CompoundTerm){
		Term *child;
		for(child = t->children; child != nil; child = child->next)
			applybinding(child, bindings);
	}
}

Goal *
copygoals(Goal *goals)
{
	if(goals != nil){
		Goal *g = gmalloc(sizeof(Goal));
		g->module = goals->module;
		g->goalnr = goals->goalnr;
		if(goals->goal)
			g->goal = copyterm(goals->goal);
		else
			g->goal = nil;
		if(goals->catcher)
			g->catcher = copyterm(goals->catcher);
		else
			g->catcher = nil;
		g->next = copygoals(goals->next);
		return g;
	}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){
			print("Created choicepoint for %S with id %ulld\n", prettyprint(goal, 0, 1, 0, nil), clause->clausenr);
			/* Add choicepoint here */
			Choicepoint *cp = gmalloc(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;
	}
}