shithub: pprolog

--- a/builtins.c

+++ b/builtins.c

@@ -5,11 +5,12 @@

 #include "dat.h"

 #include "fns.h"

-#define BuiltinProto(name) int name(Term *, Binding **)

+#define BuiltinProto(name) int name(Term *, Binding **, Module *)

 #define Match(X, Y) (runestrcmp(name, X) == 0 && arity == Y)

 #define Throw(What) do{\

 	Goal *g = malloc(sizeof(Goal)); \

 	g->goal = What; \

+	g->module = usermodule; \

 	g->catcher = nil; \

 	g->next = goalstack; \

 	goalstack = g; \

@@ -128,31 +129,27 @@

int

-builtinfail(Term *goal, Binding **bindings)

+builtinfail(Term *goal, Binding **bindings, Module *module)

 	USED(goal);

 	USED(bindings);

+	USED(module);

 	return 0;

int

-builtincall(Term *goal, Binding **bindings)

+builtincall(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

-	Goal *g = malloc(sizeof(Goal));

-	g->goal = goal->children;

-	g->catcher = nil;

-	g->next = goalstack;

-	goalstack = g;

+	goalstack = addgoals(goalstack, goal->children, module);

 	return 1;

int

-builtincut(Term *goal, Binding **bindings)

+builtincut(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Choicepoint *cp = choicestack;

@@ -166,65 +163,73 @@

int

-builtinvar(Term *goal, Binding **bindings)

+builtinvar(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag == VariableTerm);

int

-builtinatom(Term *goal, Binding **bindings)

+builtinatom(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag == AtomTerm);

int

-builtininteger(Term *goal, Binding **bindings)

+builtininteger(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag == IntegerTerm);

int

-builtinfloat(Term *goal, Binding **bindings)

+builtinfloat(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag == FloatTerm);

int

-builtinatomic(Term *goal, Binding **bindings)

+builtinatomic(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag == AtomTerm || arg->tag == FloatTerm || arg->tag == IntegerTerm);

int

-builtincompound(Term *goal, Binding **bindings)

+builtincompound(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag == CompoundTerm);

int

-builtinnonvar(Term *goal, Binding **bindings)

+builtinnonvar(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag != VariableTerm);

int

-builtinnumber(Term *goal, Binding **bindings)

+builtinnumber(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *arg = goal->children;

 	return (arg->tag == FloatTerm || arg->tag == IntegerTerm);

@@ -282,8 +287,9 @@

int

-builtincompare(Term *goal, Binding **bindings)

+builtincompare(Term *goal, Binding **bindings, Module *module)

+	USED(module);

 	Term *order = goal->children;

 	Term *t1 = order->next;

 	Term *t2 = t1->next;

@@ -302,9 +308,9 @@

int

-builtinfunctor(Term *goal, Binding **bindings)

+builtinfunctor(Term *goal, Binding **bindings, Module *module)

+	USED(module);

 	Term *term = goal->children;

 	Term *name = term->next;

 	Term *arity = name->next;

@@ -338,9 +344,9 @@

int

-builtinarg(Term *goal, Binding **bindings)

+builtinarg(Term *goal, Binding **bindings, Module *module)

+	USED(module);

 	Term *n = goal->children;

 	Term *term = n->next;

 	Term *arg = term->next;

@@ -373,8 +379,9 @@

int

-builtinuniv(Term *goal, Binding **bindings)

+builtinuniv(Term *goal, Binding **bindings, Module *module)

+	USED(module);

 	Term *term = goal->children;

 	Term *list = term->next;

@@ -445,8 +452,9 @@

int

-builtinis(Term *goal, Binding **bindings)

+builtinis(Term *goal, Binding **bindings, Module *module)

+	USED(module);

 	Term *result = goal->children;

 	Term *expr = result->next;

@@ -459,7 +467,7 @@

int

-builtincatch(Term *goal, Binding **bindings)

+builtincatch(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

@@ -469,6 +477,7 @@

 	Goal *catchframe = malloc(sizeof(Goal));

 	catchframe->goal = recover;

+	catchframe->module = module;

 	catchframe->catcher = catcher;

 	catchframe->next = goalstack;

 	goalstack = catchframe;

@@ -475,6 +484,7 @@

 	Goal *g = malloc(sizeof(Goal));

 	g->goal = catchgoal;

+	g->module = module;

 	g->catcher = nil;

 	g->next = goalstack;

 	goalstack = g;

@@ -483,9 +493,10 @@

int

-builtinthrow(Term *goal, Binding **bindings)

+builtinthrow(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *ball = goal->children;

@@ -505,6 +516,7 @@

 				goalstack = g->next;

 				Goal *newgoal = malloc(sizeof(Goal));

 				newgoal->goal = copyterm(g->goal, nil);

+				newgoal->module = module;

 				newgoal->catcher = nil;

 				newgoal->next = goalstack;

 				goalstack = newgoal;

@@ -522,17 +534,19 @@

int

-builtincurrentprologflag(Term *goal, Binding **bindings)

+builtincurrentprologflag(Term *goal, Binding **bindings, Module *module)

 	USED(goal);

 	USED(bindings);

+	USED(module);

 	return 0;

int

-builtinsetprologflag(Term *goal, Binding **bindings)

+builtinsetprologflag(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *key = goal->children;

 	Term *value = key->next;

@@ -549,9 +563,10 @@

int

-builtinopen(Term *goal, Binding **bindings)

+builtinopen(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *sourcesink = goal->children;

 	Term *mode = sourcesink->next;

@@ -584,9 +599,10 @@

int

-builtinclose(Term *goal, Binding **bindings)

+builtinclose(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *stream = goal->children;

 	Term *options = stream->next;

@@ -609,9 +625,10 @@

int

-builtincurrentinput(Term *goal, Binding **bindings)

+builtincurrentinput(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *stream = goal->children;

 	if(stream->tag != VariableTerm && stream->tag != IntegerTerm)

@@ -622,9 +639,10 @@

int

-builtincurrentoutput(Term *goal, Binding **bindings)

+builtincurrentoutput(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *stream = goal->children;

 	if(stream->tag != VariableTerm && stream->tag != IntegerTerm)

@@ -635,9 +653,10 @@

int

-builtinsetinput(Term *goal, Binding **bindings)

+builtinsetinput(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *stream = goal->children;

 	if(stream->tag == VariableTerm)

@@ -657,9 +676,10 @@

int

-builtinsetoutput(Term *goal, Binding **bindings)

+builtinsetoutput(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *stream = goal->children;

 	if(stream->tag == VariableTerm)

@@ -679,9 +699,10 @@

int

-builtinreadterm(Term *goal, Binding **bindings)

+builtinreadterm(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *stream = goal->children;

 	Term *term = stream->next;

@@ -709,9 +730,10 @@

int

-builtinwriteterm(Term *goal, Binding **bindings)

+builtinwriteterm(Term *goal, Binding **bindings, Module *module)

 	USED(bindings);

+	USED(module);

 	Term *stream = goal->children;

 	Term *term = stream->next;

--- a/dat.h

+++ b/dat.h

@@ -5,7 +5,7 @@

 typedef struct Clause Clause;

 typedef struct Predicate Predicate;

 typedef struct Module Module;

-typedef int (*Builtin)(Term *, Binding **);

+typedef int (*Builtin)(Term *, Binding **, Module *);

 struct Term

@@ -31,6 +31,7 @@

 struct Goal

 	Term *goal;

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

};

--- a/eval.c

+++ b/eval.c

@@ -5,7 +5,6 @@

 #include "dat.h"

 #include "fns.h"

-Goal *addgoals(Goal *, Term *);

 Predicate *findpredicate(Predicate *, Term *);

 Clause *findclause(Clause *, Term *, Binding **);

 int equalterms(Term *, Term *);

@@ -18,7 +17,6 @@

int

 evalquery(Term *query, Binding **resultbindings)

-	static Module *currentmodule = nil;

 	if(choicestack == nil){

/*

 		The goal stack has the original query at the very bottom, protected by a catch frame where the ->goal field is nil.

@@ -28,20 +26,21 @@

*/

 		goalstack = malloc(sizeof(Goal));

 		goalstack->goal = copyterm(query, nil);

+		goalstack->module = usermodule;

 		goalstack->catcher = nil;

 		goalstack->next = nil;

 		Goal *protector = malloc(sizeof(Goal));

 		protector->goal = nil;

+		protector->module = usermodule;

 		protector->catcher = mkvariable(L"catch-var");

 		protector->next = goalstack;

 		goalstack = protector;

 		/* Now add the actual goals */

-		goalstack = addgoals(goalstack, query);

+		goalstack = addgoals(goalstack, query, usermodule);

 		clausenr = 2; /* Start at two since 0 is for the facts in the database, and 1 is for queries */

-		currentmodule = usermodule;

 	}else{

 		goto Backtrack;

@@ -49,6 +48,7 @@

 	while(goalstack->goal != nil){

 		Term *goal = goalstack->goal;

 		Term *catcher = goalstack->catcher;

+		Module *module = goalstack->module;

 		goalstack = goalstack->next;

 		if(catcher)

@@ -55,22 +55,8 @@

 			continue;

 		if(debug)

-			print("Working goal: %S\n", prettyprint(goal, 0, 0, 0));

+			print("Working goal: %S:%S\n", module->name, prettyprint(goal, 0, 0, 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);

-				if(m == nil)

-					goal = existenceerror(L"module", module);

-				else{

-					goal = module->next;

-					currentmodule = m;

-				}

-			}else

-				goal = typeerror(L"module", module);

-		}

 		Binding *bindings = nil;

 		Clause *clause = nil;

@@ -77,13 +63,13 @@

 		/* 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);

+			int success = builtin(goal, &bindings, module);

 			if(!success)

 				goto Backtrack;

 		}else{

-			Predicate *pred = findpredicate(currentmodule->predicates, goal);

+			Predicate *pred = findpredicate(module->predicates, goal);

 			if(pred == nil){

-				print("No predicate matches: %S\n", prettyprint(goal, 0, 0, 0));

+				print("No predicate matches: %S:%S\n", module->name, prettyprint(goal, 0, 0, 0));

 				goto Backtrack;

@@ -90,7 +76,7 @@

 			/* Find a clause where the head unifies with the goal */

 			clause = findclause(pred->clauses, goal, &bindings);

 			if(clause != nil)

-				addchoicepoints(clause, goal, goalstack, currentmodule);

+				addchoicepoints(clause, goal, goalstack, module);

 			else{

 Backtrack:

 				if(choicestack == nil)

@@ -100,7 +86,7 @@

 				Choicepoint *cp = choicestack;

 				choicestack = cp->next;

 				goalstack = cp->goalstack;

-				currentmodule = cp->currentmodule;

+				module = cp->currentmodule;

 				clause = cp->alternative;

 				bindings = cp->altbindings;

@@ -117,7 +103,7 @@

 		if(clause != nil && clause->body != nil){

 			Term *subgoal = copyterm(clause->body, nil);

 			applybinding(subgoal, bindings);

-			goalstack = addgoals(goalstack, subgoal);

+			goalstack = addgoals(goalstack, subgoal, module);

 	goalstack = goalstack->next;

@@ -126,14 +112,28 @@

 Goal *

-addgoals(Goal *goals, Term *t)

+addgoals(Goal *goals, Term *t, Module *module)

 	if(t->tag == CompoundTerm && runestrcmp(t->text, L",") == 0 && t->arity == 2){

-		goals = addgoals(goals, t->children->next);

-		goals = addgoals(goals, t->children);

+		goals = addgoals(goals, t->children->next, module);

+		goals = addgoals(goals, t->children, module);

 	}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 = malloc(sizeof(Goal));

 		g->goal = t;

+		g->module = module;

 		g->catcher = nil;

 		g->next = goals;

 		goals = g;

@@ -198,7 +198,7 @@

 		if(equalterms(left, right))

 			continue;

 		else if(left->tag == VariableTerm || right->tag == VariableTerm){

-			if(right->tag == VariableTerm){

+			if(left->tag != VariableTerm && right->tag == VariableTerm){

 				Term *tmp = left;

 				left = right;

 				right = tmp;

@@ -235,8 +235,10 @@

 				rightstack = t2;

 				rightchild = rightchild->next;

-		}else

+		}else{

+			*bindings = nil;

 			return 0; /* failure */

+		}

 	return 1;

@@ -287,6 +289,7 @@

 	if(goals != nil){

 		Goal *g = malloc(sizeof(Goal));

+		g->module = goals->module;

 		if(goals->goal)

 			g->goal = copyterm(goals->goal, nil);

 		else

--- a/fns.h

+++ b/fns.h

@@ -21,6 +21,7 @@

 int evalquery(Term *, Binding **);

 int unify(Term *, Term *, Binding **);

 void applybinding(Term *, Binding *);

+Goal *addgoals(Goal *, Term *, Module *);

 /* repl.c */

 void repl(void);