shithub: pprolog

ref: 329c6975c44fcbe1cf7c9d93ab6164495f432213
dir: /builtins.c/

#include <u.h>
#include <libc.h>

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

#define BuiltinProto(name) int name(Term *, Term *, Goal **, Choicepoint **, Binding **)
#define Match(X, Y) (runestrcmp(name, X) == 0 && arity == Y)

BuiltinProto(builtinfail);
BuiltinProto(builtincall);
BuiltinProto(builtincut);
BuiltinProto(builtinvar);
BuiltinProto(builtinatom);
BuiltinProto(builtininteger);
BuiltinProto(builtinfloat);
BuiltinProto(builtinatomic);
BuiltinProto(builtincompound);
BuiltinProto(builtinnonvar);
BuiltinProto(builtinnumber);
BuiltinProto(builtinstring);
BuiltinProto(builtincompare);
BuiltinProto(builtinfunctor);
BuiltinProto(builtinarg);
BuiltinProto(builtinuniv);
BuiltinProto(builtinis);

int compareterms(Term *, Term *);

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;
	}

	/* Rewrite this so its not just a long if chain */
	if(Match(L"fail", 0))
		return builtinfail;
	if(Match(L"call", 1))
		return builtincall;
	if(Match(L"!", 0))
		return builtincut;
	if(Match(L"var", 1))
		return builtinvar;
	if(Match(L"atom", 1))
		return builtinatom;
	if(Match(L"integer", 1))
		return builtininteger;
	if(Match(L"float", 1))
		return builtinfloat;
	if(Match(L"atomic", 1))
		return builtinatomic;
	if(Match(L"compound", 1))
		return builtincompound;
	if(Match(L"nonvar", 1))
		return builtinnonvar;
	if(Match(L"number", 1))
		return builtinnumber;
	if(Match(L"string", 1))
		return builtinstring;
	if(Match(L"compare", 3))
		return builtincompare;
	if(Match(L"functor", 3))
		return builtinfunctor;
	if(Match(L"arg", 3))
		return builtinarg;
	if(Match(L"=..", 2))
		return builtinuniv;
	if(Match(L"is", 2))
		return builtinis;

	return nil;
}

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;

	/* 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 >= goal->clausenr)
		cp = cp->next;
	*choicestack = cp;
	return 1;
}

int
builtinvar(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == VariableTerm);
}

int
builtinatom(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == AtomTerm);
}

int
builtininteger(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == NumberTerm && arg->numbertype == NumberInt);
}

int
builtinfloat(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == NumberTerm && arg->numbertype == NumberFloat);
}

int
builtinatomic(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == AtomTerm || arg->tag == NumberTerm);
}

int
builtincompound(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == CompoundTerm);
}

int
builtinnonvar(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag != VariableTerm);
}

int
builtinnumber(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == NumberTerm);
}

int
builtinstring(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	USED(bindings);
	Term *arg = goal->children;
	return (arg->tag == StringTerm);
}

#define Compare(A, B) ((A < B) ? -1 : ((A > B) ? 1 : 0))

int
compareterms(Term *t1, Term *t2)
{
	int result = 0;

	if(t1->tag != t2->tag)
		result = Compare(t1->tag, t2->tag);
	else{
		/* Same type term */
		switch(t1->tag){
		case VariableTerm:
			if(t1->clausenr == t2->clausenr)
				result = runestrcmp(t1->text, t2->text);
			else
				result = Compare(t1->clausenr, t2->clausenr);
			break;
		case NumberTerm:
			if(t1->numbertype == t2->numbertype){
				if(t1->numbertype == NumberInt)
					result = Compare(t1->ival, t2->ival);
				else
					result = Compare(t1->dval, t2->dval);
			}else
				result = Compare(t1->numbertype, t2->numbertype);
			break;
		case StringTerm:
		case AtomTerm:
			result = runestrcmp(t1->text, t2->text);
			break;
		case CompoundTerm:
			result = Compare(t1->arity, t2->arity);
			if(result != 0)
				break;

			result = runestrcmp(t1->text, t2->text);
			if(result != 0)
				break;

			t1 = t1->children;
			t2 = t2->children;
			while(t1 != nil && t2 != nil){
				result = compareterms(t1, t2);
				if(result != 0)
					break;
				else
					t1 = t1->next;
					t2 = t2->next;
			}
			break;
		}
	}
	return result;
}

int
builtincompare(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	Term *order = goal->children;
	Term *t1 = order->next;
	Term *t2 = t1->next;

	int result = compareterms(t1, t2);

	Term *resultorder;
	if(result == -1)
		resultorder = mkatom(L"<");
	else if(result == 0)
		resultorder = mkatom(L"=");
	else
		resultorder = mkatom(L">");

	return unify(order, resultorder, bindings);
}

int
builtinfunctor(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);

	Term *term = goal->children;
	Term *name = term->next;
	Term *arity = name->next;

	if(term->tag == CompoundTerm){
		Term *realname = mkatom(term->text);
		Term *realarity = mknumber(NumberInt, term->arity, 0);
		if(unify(name, realname, bindings) && unify(arity, realarity, bindings))
			return 1;
	}else if(arity->tag == NumberTerm && arity->numbertype == NumberInt &&
			(name->tag == AtomTerm || name->tag == NumberTerm)){
		if(arity->ival == 0)
			return unify(term, name, bindings);
		else{
			if(name->tag != AtomTerm)
				return 0;

			/* Make arity maky fresh variables */
			int i;
			Term *args = nil;
			for(i = 0; i < arity->ival; i++){
				Rune *varname = runesmprint("FunctorVar%d", i);
				Term *arg = mkvariable(varname);
				args = appendterm(args, arg);
			}
			Term *realterm = mkcompound(name->text, arity->ival, args);
			return unify(term, realterm, bindings);
		}
	}
	return 0;
}

int
builtinarg(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);

	Term *n = goal->children;
	Term *term = n->next;
	Term *arg = term->next;

	if(n->tag != NumberTerm || n->numbertype != NumberInt || n->ival < 0)
		return 0;
	if(term->tag != CompoundTerm)
		return 0;
	if(n->ival >= term->arity)
		return 0;

	int i;
	Term *t;
	for(i = 0, t = term->children; i < n->ival; i++, t = t->next);
	return unify(arg, t, bindings);
}

Term *
mklist(Term *elems)
{
	if(elems == nil)
		return mkatom(L"[]");
	else{
		Term *t = copyterm(elems, nil);
		t->next = mklist(elems->next);
		return mkcompound(L".", 2, t);
	}
}

int
listlength(Term *term)
{
	if(term->tag == AtomTerm && runestrcmp(term->text, L"[]") == 0)
		return 0;
	else if(term->tag == CompoundTerm && term->arity == 2 && runestrcmp(term->text, L".") == 0){
		int taillength = listlength(term->children->next);
		return (taillength == -1) ? -1 : 1 + taillength;
	}else
		return -1;
}

int
builtinuniv(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	Term *term = goal->children;
	Term *list = term->next;

	int len;
	if(term->tag == VariableTerm){
		Rune *name;
		Term *elems = nil;
		Term *realterm;
		int i;

		len = listlength(list);
		if(len < 1)
			return 0;
		if(list->children->tag != AtomTerm)
			return 0;
		name = list->children->text;

		list = list->children->next;
		for(i = 1; i < len; i++){
			Term *t = copyterm(list->children, nil);
			elems = appendterm(elems, t);
			list = list->children->next;
		}
		realterm = mkcompound(name, len-1, elems);
		return unify(term, realterm, bindings);
	}else if(term->tag == CompoundTerm){
		Term *elems = mkatom(term->text);
		elems->next = term->children;
		Term *reallist = mklist(elems);
		return unify(list, reallist, bindings);
	}else{
		Term *t = copyterm(term, nil);
		t->next = mkatom(L"[]");
		Term *reallist = mkcompound(L".", 2, t);
		return unify(list, reallist, bindings);
	}
}

#define ToFloat(t) (t->numbertype == NumberInt ? (double)t->ival : t->dval)

Term *
aritheval(Term *expr)
{
	/* Not every arithmetic operation is defined right now. */

	if(expr->tag == NumberTerm)
		return expr;
	else if(expr->tag == CompoundTerm && expr->arity == 2){
		Term *A = aritheval(expr->children);
		Term *B = aritheval(expr->children->next);
		Term *result = mknumber(NumberInt, 0, 0);

		if(A == nil || B == nil)
			return nil;
		if(runestrcmp(expr->text, L"+") == 0){
			if(A->numbertype == NumberInt && B->numbertype == NumberInt){
				result->numbertype = NumberInt;
				result->ival = A->ival + B->ival;
			}else{
				result->numbertype = NumberFloat;
				result->dval = ToFloat(A) + ToFloat(B);
			}
		}else
			return nil;
		return result;
	}else
		return nil;
}

int
builtinis(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{
	USED(database);
	USED(goals);
	USED(choicestack);
	Term *result = goal->children;
	Term *expr = result->next;

	
	Term *realresult = aritheval(expr);
	if(realresult)
		return unify(result, realresult, bindings);
	else
		return 0;
}