shithub: pprolog

--- a/builtins.c

+++ b/builtins.c

@@ -893,7 +893,6 @@

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

 	USED(bindings);

-	USED(module);

 	Term *stream = goal->children;

 	Term *term = stream->next;

@@ -911,7 +910,7 @@

 		Throw(permissionerror(L"input", L"binary_stream", stream));

 	Term *realterm;

-	int error = readterm(stream, &realterm);

+	int error = readterm(stream, &realterm, module);

 	if(error)

 		Throw(realterm);

@@ -942,7 +941,7 @@

 		varsnames = varsandnames(uniquevars);

 		singlevars = singletons(allvars);

 	Term *op;

 	for(op = options; op->tag == CompoundTerm; op = op->children->next){

 		Term *opkey = op->children->children;

--- a/eval.c

+++ b/eval.c

@@ -66,6 +66,17 @@

 					name = prettyprint(goal, 0, 0, 0, nil);

 					arity = 0;

+				print("Didn't find predicate %S in module %S\n", prettyprint(goal, 0, 0, 0, nil), module->name);

+				Predicate *p;

+				for(p = module->predicates; p != nil; p = p->next)

+					print("Available in %S: %S/%d\n", module->name, p->name, p->arity);

+				Module *sysmod;

+				if(systemmoduleloaded)

+					sysmod = getmodule(L"system");

+				else

+					sysmod = getmodule(L"user");

+				for(p = sysmod->predicates; p != nil; p = p->next)

+					print("Available in %S: %S/%d\n", sysmod->name, p->name, p->arity);

 				switch(flagunknown){

 				case UnknownError:

 					procedure = mkatom(name);

--- a/fns.h

+++ b/fns.h

@@ -1,5 +1,5 @@

 /* parser.c */

-Term *parse(int, Biobuf *, int);

+Term *parse(Biobuf *, Module *);

 /* prettyprint.c */

 Rune *prettyprint(Term *, int, int, int, Module *);

@@ -58,7 +58,7 @@

 int istextstream(Term *);

 int isbinarystream(Term *);

 int canreposition(Term *);

-int readterm(Term *, Term **);

+int readterm(Term *, Term **, Module *);

 void writeterm(Term *, Term *, Term *, Module *);

 Rune getchar(Term *);

 Rune peekchar(Term *);

--- a/loader.pl

+++ b/loader.pl

@@ -55,17 +55,21 @@

 read_and_handle_terms(Stream, Module0, Module) :-

-	( read_one_term(Stream, Term, Singles)

+	( read_one_term(Stream, Term, Module0, Singles)

 	-> handle_term(Term, Singles, Module0, Module1),

 	   read_and_handle_terms(Stream, Module1, Module)

 	; Module = Module0

).

-read_one_term(Stream, Term, Singles) :-

+read_one_term(Stream, Term, Module0, Singles) :-

 	consume_whitespace(Stream),

 	peek_char(Stream, NextCh),

 	NextCh \= end_of_file,

-	read_term(Stream, Term, [singletons(Singletons)]),

+	( Module0 == system

+	-> read_term(Stream, Term, [singletons(Singletons)])

+	; Module0:read_term(Stream, Term, [singletons(Singletons)])

+	% For all other modules than system use Mod:read_term, to use the correct operators

+	),

 	singleton_names(Singletons, Singles).

 whitespace(' ').

--- a/module.c

+++ b/module.c

@@ -5,6 +5,8 @@

 #include "dat.h"

 #include "fns.h"

+void handleopdirective(Term *, Module *);

 void

 initmodules(void)

@@ -22,24 +24,25 @@

int

 addtousermod(char *file)

-	int fd = open(file, OREAD);

-	if(fd < 0)

+	Biobuf *bio = Bopen(file, OREAD);

+	if(bio == nil)

 		return 0;

 	Module *usermodule = getmodule(L"user");

-	Term *terms = parse(fd, nil, 0);

-	if(terms == nil)

-		return 0;

 	Predicate *currentpred = nil;

 	Term *t;

-	for(t = terms; t != nil; t = t->next){

+	while(t = parse(bio, usermodule)){

 		Clause *cl = gmalloc(sizeof(Clause));

 		int arity;

 		cl->clausenr = 0;

 		cl->next = nil;

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

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

+			Term *body = t->children;

+			if(runestrcmp(body->text, L"op") == 0 && body->arity == 3)

+				handleopdirective(body->children, usermodule);

+			continue;

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

 			cl->head = t->children;

 			cl->body = t->children->next;

 		}else{

@@ -66,6 +69,8 @@

 			currentpred->clauses = appendclause(currentpred->clauses, cl);

 	usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);

+	Bterm(bio);

 	return 1;

@@ -185,4 +190,43 @@

 	op->spelling = spelling;

 	op->next = mod->operators[level-1];

 	mod->operators[level-1] = op;

+}

+void

+handleopdirective(Term *args, Module *mod)

+{

+	Term *levelt = args;

+	Term *typet = levelt->next;

+	Term *opt = typet->next;

+	if(levelt->tag == IntegerTerm

+	    && levelt->ival >= 0

+	    && levelt->ival <= PrecedenceLevels

+	    && typet->tag == AtomTerm

+	    && opt->tag == AtomTerm){

+		int level = levelt->ival;

+		Rune *spelling = opt->text;

+		int type = 0;

+		if(runestrcmp(typet->text, L"xf") == 0)

+			type = Xf;

+		else if(runestrcmp(typet->text, L"yf") == 0)

+			type = Yf;

+		else if(runestrcmp(typet->text, L"xfx") == 0)

+			type = Xfx;

+		else if(runestrcmp(typet->text, L"xfy") == 0)

+			type = Xfy;

+		else if(runestrcmp(typet->text, L"yfx") == 0)

+			type = Yfx;

+		else if(runestrcmp(typet->text, L"fy") == 0)

+			type = Fy;

+		else if(runestrcmp(typet->text, L"fx") == 0)

+			type = Fx;

+		if(type != 0){

+			addoperator(level, type, spelling, mod);

+			return;

+		}

+	}

+	print("Malformed op directive with level=%S, type=%S, op=%S\n",

+		prettyprint(levelt, 0, 0, 0, mod),

+		prettyprint(typet, 0, 0, 0, mod),

+		prettyprint(opt, 0, 0, 0, mod));

\ No newline at end of file

--- a/parser.c

+++ b/parser.c

@@ -52,68 +52,33 @@

 Term *parseoperators(Term *);

 void match(int);

 void syntaxerror_parser(char *);

-Term *prologtext(int);

-void handlemoduledirective(Term *);

-void handleopdirective(Term *);

+Term *parseterm(void);

 Term *

-parse(int fd, Biobuf *bio, int querymode)

+parse(Biobuf *bio, Module *mod)

-	if(bio == nil){

-		fd = dup(fd, -1);

-		parsein = Bfdopen(fd, OREAD);

-		if(parsein == nil){

-			print("Could not open file\n");

-			return nil;

-		}

-	}else

-		parsein = bio;

+	parsein = bio;

+	currentmod = mod;

 	nexttoken();

-	currentmod = getmodule(L"user");

-	Term *result = prologtext(querymode);

-	if(querymode && result){

+	Term *result = parseterm();

+	if(result){

 		result = copyterm(result, &clausenr);

 		clausenr++;

-	if(!bio)

-		Bterm(parsein);

 	return result;

 Term *

-prologtext(int querymode)

+parseterm(void)

 	if(lookahead.tag == EofTok)

 		return nil;

 	Term *t = fullterm(AtomTok, L".", nil);

-	if(lookahead.tag == AtomTok && runestrcmp(lookahead.text, L".") == 0){

-		if(!querymode)

-			match(AtomTok);

-	}else

-		syntaxerror_parser("prologtext");

+	if(lookahead.tag != AtomTok || runestrcmp(lookahead.text, L".") != 0)

+		syntaxerror_parser("parseterm");

-	if(querymode)

-		return t;

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

-		Term *body = t->children;

-		if(runestrcmp(body->text, L"op") == 0 && body->arity == 3)

-			handleopdirective(body->children);

-		t = prologtext(querymode);

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

-		t->next = prologtext(querymode);

-	}else if(t->tag == AtomTerm || t->tag == CompoundTerm){

-		t->next = prologtext(querymode);

-	}else{

-		print("Expected directive or clause as toplevel\n");

-		syntaxerror_parser("prologtext");

-	}

 	return t;

@@ -572,42 +537,3 @@

 	print("Syntax error: Unexpected %d (%S) token in %s\n", lookahead.tag, lookahead.text, where);

 	exits("syntax error");

-void

-handleopdirective(Term *args)

-{

-	Term *levelt = args;

-	Term *typet = levelt->next;

-	Term *opt = typet->next;

-	if(levelt->tag == IntegerTerm

-	    && levelt->ival >= 0

-	    && levelt->ival <= PrecedenceLevels

-	    && typet->tag == AtomTerm

-	    && opt->tag == AtomTerm){

-		int level = levelt->ival;

-		Rune *spelling = opt->text;

-		int type = 0;

-		if(runestrcmp(typet->text, L"xf") == 0)

-			type = Xf;

-		else if(runestrcmp(typet->text, L"yf") == 0)

-			type = Yf;

-		else if(runestrcmp(typet->text, L"xfx") == 0)

-			type = Xfx;

-		else if(runestrcmp(typet->text, L"xfy") == 0)

-			type = Xfy;

-		else if(runestrcmp(typet->text, L"yfx") == 0)

-			type = Yfx;

-		else if(runestrcmp(typet->text, L"fy") == 0)

-			type = Fy;

-		else if(runestrcmp(typet->text, L"fx") == 0)

-			type = Fx;

-		if(type != 0){

-			addoperator(level, type, spelling, currentmod);

-			return;

-		}

-	}

-	print("Malformed op directive with level=%S, type=%S, op=%S\n",

-		prettyprint(levelt, 0, 0, 0, currentmod),

-		prettyprint(typet, 0, 0, 0, currentmod),

-		prettyprint(opt, 0, 0, 0, currentmod));

-}

\ No newline at end of file

--- a/streams.c

+++ b/streams.c

@@ -217,7 +217,7 @@

int

-readterm(Term *stream, Term **term)

+readterm(Term *stream, Term **term, Module *mod)

 	Stream *s = getstream(stream);

 	if(s == nil){

@@ -224,7 +224,7 @@

 		*term = existenceerror(L"stream", stream);

 		return 1;

-	*term = parse(0, s->bio, 1);

+	*term = parse(s->bio, mod);

 	return 0;