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 changesHEADfront

10 files changed, 106 insertions, 138 deletions

diff --git a/builtins.c b/builtins.c
index 7d32d98..7ef74df 100644
--- a/builtins.c
+++ b/builtins.c
@@ -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;
diff --git a/dat.h b/dat.h
index 2855a3e..1061d47 100644
--- a/dat.h
+++ b/dat.h
@@ -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;
diff --git a/error.c b/error.c
index d5ff0bf..ba2877e 100644
--- a/error.c
+++ b/error.c
@@ -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);
 }
 
diff --git a/eval.c b/eval.c
index c8388e6..b5f78bc 100644
--- a/eval.c
+++ b/eval.c
@@ -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);
diff --git a/fns.h b/fns.h
index a45af7e..c975ceb 100644
--- a/fns.h
+++ b/fns.h
@@ -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 **);
 
diff --git a/misc.c b/misc.c
index bf7010f..91396bd 100644
--- a/misc.c
+++ b/misc.c
@@ -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)
diff --git a/parser.c b/parser.c
index 9ce68f1..5758af8 100644
--- a/parser.c
+++ b/parser.c
@@ -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));
diff --git a/streams.c b/streams.c
index 29e8746..54d5b2d 100644
--- a/streams.c
+++ b/streams.c
@@ -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);
diff --git a/system.pl b/system.pl
index 5883aee..35db774 100644
--- a/system.pl
+++ b/system.pl
@@ -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
diff --git a/types.c b/types.c
index 0e70abf..bb672df 100644
--- a/types.c
+++ b/types.c
@@ -69,4 +69,4 @@ listtail(Term *t)
 		return t->children->next;
 	else
 		return nil;
-}
\ No newline at end of file
+}