~pmikkelsen/pprolog

13efe91101a11f41caf6321a8b2fbdd96ef9927a — Peter Mikkelsen 4 months ago 4fba3e6 front
remove clausenr from terms, and put it into goals instead. Next up is implementing the control constructs in C, since they misbehave right now due to the new changes
10 files changed, 106 insertions(+), 138 deletions(-)

M builtins.c
M dat.h
M error.c
M eval.c
M fns.h
M misc.c
M parser.c
M streams.c
M system.pl
M types.c
M builtins.c => builtins.c +12 -87
@@ 20,7 20,6 @@
BuiltinProto(builtintrue);
BuiltinProto(builtinfail);
BuiltinProto(builtincall);
BuiltinProto(builtincut);
BuiltinProto(builtinvar);
BuiltinProto(builtinatom);
BuiltinProto(builtininteger);


@@ 36,7 35,6 @@ BuiltinProto(builtinuniv);
BuiltinProto(builtincopyterm);
BuiltinProto(builtinis);
BuiltinProto(builtincatch);
BuiltinProto(builtinthrow);
BuiltinProto(builtinsetprologflag);
BuiltinProto(builtincurrentprologflags);
BuiltinProto(builtinopen);


@@ 101,8 99,6 @@ findbuiltin(Term *goal)
		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))


@@ 133,8 129,6 @@ findbuiltin(Term *goal)
		return builtinis;
	if(Match(L"catch", 3))
		return builtincatch;
	if(Match(L"throw", 1))
		return builtinthrow;
	if(Match(L"$set_prolog_flag", 2))
		return builtinsetprologflag;
	if(Match(L"current_prolog_flags", 1))


@@ 241,21 235,6 @@ canbecalled(Term *t)
		return 1;
}

void
updateclausenr(Term *t, uvlong nr)
{
	/* Change the clause number on the term and its subterms, unless it is a variable */
	if(t->tag == VariableTerm)
		return;

	t->clausenr = nr;
	if(t->tag == CompoundTerm){
		Term *child;
		for(child = t->children; child != nil; child = child->next)
			updateclausenr(child, nr);
	}
}

int
builtincall(Term *goal, Binding **bindings, Module *module)
{


@@ 265,27 244,7 @@ builtincall(Term *goal, Binding **bindings, Module *module)
	if(!canbecalled(callgoal))
		Throw(typeerror(L"callable", callgoal));

	updateclausenr(callgoal, clausenr);
	clausenr++;

	goalstack = addgoals(goalstack, callgoal, module);
	return 1;
}

int
builtincut(Term *goal, Binding **bindings, Module *module)
{
	USED(bindings);
	USED(module);

	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;
	goalstack = addgoals(goalstack, callgoal, module, clausenr++);
	return 1;
}



@@ 563,7 522,7 @@ builtinuniv(Term *goal, Binding **bindings, Module *module)

		list = list->children->next;
		for(i = 1; i < len; i++){
			Term *t = copyterm(list->children, nil);
			Term *t = copyterm(list->children);
			elems = appendterm(elems, t);
			list = list->children->next;
		}


@@ 575,7 534,7 @@ builtinuniv(Term *goal, Binding **bindings, Module *module)
		Term *reallist = mklist(elems);
		return unify(list, reallist, bindings);
	}else{
		Term *t = copyterm(term, nil);
		Term *t = copyterm(term);
		t->next = mkatom(L"[]");
		Term *reallist = mkcompound(L".", 2, t);
		return unify(list, reallist, bindings);


@@ 588,8 547,8 @@ builtincopyterm(Term *goal, Binding **bindings, Module *module)
	USED(module);
	Term *term1 = goal->children;
	Term *term2 = term1->next;
	Term *t = copyterm(term1, &clausenr);
	clausenr++;
	Term *t = copyterm(term1);
	renametermvars(t);
	return unify(term2, t, bindings);
}



@@ 623,44 582,11 @@ builtincatch(Term *goal, Binding **bindings, Module *module)
	catchframe->next = goalstack;
	goalstack = catchframe;

	goalstack = addgoals(goalstack, catchgoal, module);
	goalstack = addgoals(goalstack, catchgoal, module, clausenr++);
	return 1;
}

int
builtinthrow(Term *goal, Binding **bindings, Module *module)
{
	USED(bindings);
	USED(module);

	Term *ball = goal->children;

	Goal *g;
	for(g = goalstack; g != nil; 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, nil);
			newgoal->module = g->module;
			newgoal->catcher = nil;
			newgoal->next = goalstack;
			goalstack = newgoal;
			applybinding(newgoal->goal, *bindings);

			Choicepoint *cp = choicestack;
			while(cp != nil && cp->id >= goal->clausenr)
				cp = cp->next;
			choicestack = cp;
			return 1;
		}
	}
	return 0;
}

int
builtincurrentprologflags(Term *goal, Binding **bindings, Module *module)
{
	USED(module);


@@ 852,13 778,13 @@ builtinreadterm(Term *goal, Binding **bindings, Module *module)
	if(options->tag == CompoundTerm){
		VarName *vn;
		for(vn = varnames; vn != nil; vn = vn->next){
			uniquevars = appendterm(uniquevars, copyterm(vn->var, nil));
			uniquevars = appendterm(uniquevars, copyterm(vn->var));
			Term *name = mkatom(vn->name);
			name->next = copyterm(vn->var, nil);
			name->next = copyterm(vn->var);
			Term *vnpair = mkcompound(L"=", 2, name);
			varsnames = appendterm(varsnames, vnpair);
			if(vn->count == 1)
				singlevars = appendterm(singlevars, copyterm(vnpair, nil));
				singlevars = appendterm(singlevars, copyterm(vnpair));
		}
	}



@@ 1053,11 979,10 @@ assertclause(Term *clause, Module *module, int after, int dynamic)
	else
		arity = 0;

	uvlong id = 0;
	Clause *cl = gmalloc(sizeof(Clause));
	cl->head = copyterm(head, &id);
	cl->body = copyterm(body, &id);
	cl->clausenr = id;
	cl->head = copyterm(head);
	cl->body = copyterm(body);
	cl->clausenr = 0;
	cl->next = nil;

	Predicate *p;

M dat.h => dat.h +1 -1
@@ 30,7 30,6 @@ struct Term
{
	u8int tag;
	u8int inparens;
	uvlong clausenr;
	Term *next;

	union {


@@ 51,6 50,7 @@ struct Binding
struct Goal
{
	Term *goal;
	uvlong goalnr; /* What clause caused this goal to be activated? */
	Module *module; /* What module is this goal to be evaluated in? */
	Term *catcher; /* When this is non-nil, the goal is a catch frame, goal is the recovery. */
	Goal *next;

M error.c => error.c +4 -4
@@ 15,7 15,7 @@ Term *
typeerror(Rune *validtype, Term *culprit)
{
	Term *valid = mkatom(validtype);
	valid->next = copyterm(culprit, nil);
	valid->next = copyterm(culprit);
	return mkcompound(L"type_error", 2, valid);
}



@@ 23,7 23,7 @@ Term *
domainerror(Rune *validdomain, Term *culprit)
{
	Term *valid = mkatom(validdomain);
	valid->next = copyterm(culprit, nil);
	valid->next = copyterm(culprit);
	return mkcompound(L"domain_error", 2, valid);
}



@@ 31,7 31,7 @@ Term *
existenceerror(Rune *objecttype, Term *culprit)
{
	Term *obj = mkatom(objecttype);
	obj->next = copyterm(culprit, nil);
	obj->next = copyterm(culprit);
	return mkcompound(L"existence_error", 2, obj);
}



@@ 40,7 40,7 @@ permissionerror(Rune *operation, Rune *permissiontype, Term *culprit)
{
	Term *op = mkatom(operation);
	op->next = mkatom(permissiontype);
	op->next->next = copyterm(culprit, nil);
	op->next->next = copyterm(culprit);
	return mkcompound(L"permission_error", 3, op);
}


M eval.c => eval.c +59 -16
@@ 14,19 14,20 @@ int
evalquery(Term *query)
{
	Binding *replbindings = nil;
	goalstack = addgoals(goalstack, query, getmodule(L"user"));
	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: %S:%S\n", module->name, prettyprint(goal, 0, 0, 0, nil));
			print("Working goal %ulld: %S:%S\n", goalnr, module->name, prettyprint(goal, 0, 1, 0, nil));

		if(goal->tag == VariableTerm)
			goal = instantiationerror();


@@ 35,7 36,46 @@ evalquery(Term *query)

		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){


@@ 79,7 119,7 @@ evalquery(Term *query)
				case UnknownFail:
					replacement = mkatom(L"fail");
				}
				goalstack = addgoals(goalstack, replacement, module);
				goalstack = addgoals(goalstack, replacement, module, goalnr);
				continue;
			}



@@ 111,9 151,9 @@ Backtrack:

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


@@ 122,11 162,11 @@ Backtrack:
}

Goal *
addgoals(Goal *goals, Term *t, Module *module)
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);
		goals = addgoals(goals, t->children, module);
		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;


@@ 143,6 183,7 @@ addgoals(Goal *goals, Term *t, Module *module)
		}
		Goal *g = gmalloc(sizeof(Goal));
		g->goal = t;
		g->goalnr = goalnr;
		g->module = module;
		g->catcher = nil;
		g->next = goals;


@@ 194,8 235,8 @@ unify(Term *a, Term *b, Binding **bindings)
	Term *left;
	Term *right;

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

	while(leftstack != nil && rightstack != nil){
		left = leftstack;


@@ 211,7 252,7 @@ unify(Term *a, Term *b, Binding **bindings)
				left = right;
				right = tmp;
			}
			if(left->tag == VariableTerm && right->tag == VariableTerm && right->clausenr > left->clausenr){
			if(left->tag == VariableTerm && right->tag == VariableTerm && right->varnr > left->varnr){
				Term *tmp = left;
				left = right;
				right = tmp;


@@ 235,12 276,12 @@ unify(Term *a, Term *b, Binding **bindings)
			Term *leftchild = left->children;
			Term *rightchild = right->children;
			while(leftchild != nil && rightchild != nil){
				Term *t1 = copyterm(leftchild, nil);
				Term *t1 = copyterm(leftchild);
				t1->next = leftstack;
				leftstack = t1;
				leftchild = leftchild->next;

				Term *t2 = copyterm(rightchild, nil);
				Term *t2 = copyterm(rightchild);
				t2->next = rightstack;
				rightstack = t2;
				rightchild = rightchild->next;


@@ 300,12 341,13 @@ 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, nil);
			g->goal = copyterm(goals->goal);
		else
			g->goal = nil;
		if(goals->catcher)
			g->catcher = copyterm(goals->catcher, nil);
			g->catcher = copyterm(goals->catcher);
		else
			g->catcher = nil;
		g->next = copygoals(goals->next);


@@ 325,6 367,7 @@ addchoicepoints(Clause *clause, Term *goal, Goal *goals, Module *mod){
		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);

M fns.h => fns.h +3 -2
@@ 5,7 5,8 @@ Term *parse(Biobuf *, Module *, VarName **);
Rune *prettyprint(Term *, int, int, int, Module *);

/* misc.c */
Term *copyterm(Term *, uvlong *);
Term *copyterm(Term *);
void renametermvars(Term *);
void renameclausevars(Clause *);
Term *appendterm(Term *, Term *);
int termslength(Term *);


@@ 22,7 23,7 @@ Clause *copyclause(Clause *, uvlong *);
int evalquery(Term *);
int unify(Term *, Term *, Binding **);
void applybinding(Term *, Binding *);
Goal *addgoals(Goal *, Term *, Module *);
Goal *addgoals(Goal *, Term *, Module *, uvlong);
Predicate *findpredicate(Predicate *, Term *);
Clause *findclause(Clause *, Term *, Binding **);


M misc.c => misc.c +13 -11
@@ 8,22 8,17 @@
static uvlong varnr = 0;

Term *
copyterm(Term *orig, uvlong *clausenr)
copyterm(Term *orig)
{
	Term *new = gmalloc(sizeof(Term));
	memcpy(new, orig, sizeof(Term));
	new->next = nil;
	new->children = nil;

	if(clausenr)
		new->clausenr = *clausenr;
	else
		new->clausenr = orig->clausenr;

	if(orig->tag == CompoundTerm){
		Term *child;
		for(child = orig->children; child != nil; child = child->next)
			new->children = appendterm(new->children, copyterm(child, clausenr));
			new->children = appendterm(new->children, copyterm(child));
	}
	return new;
}


@@ 68,6 63,14 @@ addvarnr(Term *t, uvlong offset)
}

void
renametermvars(Term *t)
{
	uvlong minvar = smallestvar(t);
	uvlong offset = varnr - minvar;
	addvarnr(t, offset);
}

void
renameclausevars(Clause *c)
{
	uvlong minhead = smallestvar(c->head);


@@ 108,7 111,6 @@ mkterm(int tag)
	t->next = nil;
	t->children = nil;
	t->text = nil;
	t->clausenr = 0;
	t->inparens = 0;
	t->varnr = 0;
	return t;


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


@@ 201,9 203,9 @@ Clause *
copyclause(Clause *orig, uvlong *clausenr)
{
	Clause *new = gmalloc(sizeof(Clause));
	new->head = copyterm(orig->head, clausenr);
	new->head = copyterm(orig->head);
	if(orig->body)
		new->body = copyterm(orig->body, clausenr);
		new->body = copyterm(orig->body);
	else
		new->body = nil;
	if(clausenr)

M parser.c => parser.c +1 -5
@@ 66,10 66,6 @@ parse(Biobuf *bio, Module *mod, VarName **vns)

	Term *result = parseterm();
	*vns = varnames;
	if(result){
		result = copyterm(result, &clausenr);
		clausenr++;
	}
	return result;
}



@@ 215,7 211,7 @@ parsevar(void)
	for(vn = varnames; vn != nil; vn = vn->next, i++)
		if(runestrcmp(vn->name, name) == 0 && !runestrcmp(vn->name, L"_") == 0){
			vn->count++;
			return copyterm(vn->var, nil);
			return copyterm(vn->var);
		}

	VarName *new = gmalloc(sizeof(VarName));

M streams.c => streams.c +9 -9
@@ 365,7 365,7 @@ Term *streamproperties(Stream *s)
	/* file_name(F) */
	if(s->filename){
		arg = mkatom(s->filename);
		data = copyterm(stream, nil);
		data = copyterm(stream);
		data->next = mkcompound(L"file_name", 1, arg);
		prop = mkcompound(L"prop", 2, data);
		props = appendterm(props, prop);


@@ 377,13 377,13 @@ Term *streamproperties(Stream *s)
	case WriteStream: arg = mkatom(L"write"); break;
	case AppendStream: arg = mkatom(L"append"); break;
	}
	data = copyterm(stream, nil);
	data = copyterm(stream);
	data->next = mkcompound(L"mode", 1, arg);
	prop = mkcompound(L"prop", 2, data);
	props = appendterm(props, prop);

	/* input or output */
	data = copyterm(stream, nil);
	data = copyterm(stream);
	if(s->mode == ReadStream)
		data->next = mkatom(L"input");
	else


@@ 395,7 395,7 @@ Term *streamproperties(Stream *s)
	int i;
	for(i = 0; i < s->nalias; i++){
		arg = mkatom(s->aliases[i]);
		data = copyterm(stream, nil);
		data = copyterm(stream);
		data->next = mkcompound(L"alias", 1, arg);
		prop = mkcompound(L"prop", 2, data);
		props = appendterm(props, prop);


@@ 404,7 404,7 @@ Term *streamproperties(Stream *s)
	/* position(P) */
	if(s->reposition){
		arg = mkinteger(Boffset(s->bio));
		data = copyterm(stream, nil);
		data = copyterm(stream);
		data->next = mkcompound(L"position", 1, arg);
		prop = mkcompound(L"prop", 2, data);
		props = appendterm(props, prop);


@@ 419,7 419,7 @@ Term *streamproperties(Stream *s)
			Bungetrune(s->bio);
			arg = mkatom(L"not");
		}
		data = copyterm(stream, nil);
		data = copyterm(stream);
		data->next = mkcompound(L"end_of_stream", 1, arg);
		prop = mkcompound(L"prop", 2, data);
		props = appendterm(props, prop);


@@ 431,7 431,7 @@ Term *streamproperties(Stream *s)
	case EofActionEof: arg = mkatom(L"eof_code"); break;
	case EofActionReset: arg = mkatom(L"reset"); break;
	}
	data = copyterm(stream, nil);
	data = copyterm(stream);
	data->next = mkcompound(L"eof_action", 1, arg);
	prop = mkcompound(L"prop", 2, data);
	props = appendterm(props, prop);


@@ 441,7 441,7 @@ Term *streamproperties(Stream *s)
		arg = mkatom(L"true");
	else
		arg = mkatom(L"false");
	data = copyterm(stream, nil);
	data = copyterm(stream);
	data->next = mkcompound(L"reposition", 1, arg);
	prop = mkcompound(L"prop", 2, data);
	props = appendterm(props, prop);


@@ 451,7 451,7 @@ Term *streamproperties(Stream *s)
		arg = mkatom(L"text");
	else
		arg = mkatom(L"binary");
	data = copyterm(stream, nil);
	data = copyterm(stream);
	data->next = mkcompound(L"type", 1, arg);
	prop = mkcompound(L"prop", 2, data);
	props = appendterm(props, prop);

M system.pl => system.pl +3 -2
@@ 69,8 69,6 @@ If ; _ :-
_ ; Else :-
	Else.

A , B :- A , B.

% Term unification
A = A.



@@ 696,3 694,6 @@ halt :-

consult(File) :-
	loader:load_module_from_file(File).

twice(!) :- '$write_term'(4, 'C ', []).
twice(true) :- '$write_term'(4, 'Moss ', []).
\ No newline at end of file

M types.c => types.c +1 -1
@@ 69,4 69,4 @@ listtail(Term *t)
		return t->children->next;
	else
		return nil;
}
\ No newline at end of file
}