~pmikkelsen/pprolog

c85de58a2047c4858825d03977e490db6168fbe3 — Peter Mikkelsen 2 months ago 43f65cb
Simplify parsing a bit, and make sure the prolog loader calls read_term with the correct module to pick up the correct operators
7 files changed, 86 insertions(+), 102 deletions(-)

M builtins.c
M eval.c
M fns.h
M loader.pl
M module.c
M parser.c
M streams.c
M builtins.c => builtins.c +2 -3
@@ 893,7 893,6 @@ int
builtinreadterm(Term *goal, Binding **bindings, Module *module)
{
	USED(bindings);
	USED(module);

	Term *stream = goal->children;
	Term *term = stream->next;


@@ 911,7 910,7 @@ builtinreadterm(Term *goal, Binding **bindings, Module *module)
		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 @@ builtinreadterm(Term *goal, Binding **bindings, Module *module)
		varsnames = varsandnames(uniquevars);
		singlevars = singletons(allvars);
	}
	

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

M eval.c => eval.c +11 -0
@@ 66,6 66,17 @@ evalquery(Term *query)
					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);

M fns.h => fns.h +2 -2
@@ 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 isoutputstream(Term *);
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 *);

M loader.pl => loader.pl +7 -3
@@ 55,17 55,21 @@ print_initialization_goal_error(Module, Goal, Exception) :-
	

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(' ').

M module.c => module.c +53 -9
@@ 5,6 5,8 @@
#include "dat.h"
#include "fns.h"

void handleopdirective(Term *, Module *);

void
initmodules(void)
{


@@ 22,24 24,25 @@ initmodules(void)
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 @@ addtousermod(char *file)
			currentpred->clauses = appendclause(currentpred->clauses, cl);
	}
	usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);

	Bterm(bio);
	return 1;
}



@@ 185,4 190,43 @@ addoperator(int level, int type, Rune *spelling, Module *mod)
	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

M parser.c => parser.c +9 -83
@@ 52,67 52,32 @@ Term *compound(void);
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(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");
	}
	if(lookahead.tag != AtomTok || runestrcmp(lookahead.text, L".") != 0)
		syntaxerror_parser("parseterm");

	return t;
}


@@ 572,42 537,3 @@ syntaxerror_parser(char *where)
	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

M streams.c => streams.c +2 -2
@@ 217,14 217,14 @@ canreposition(Term *t)
}

int
readterm(Term *stream, Term **term)
readterm(Term *stream, Term **term, Module *mod)
{
	Stream *s = getstream(stream);
	if(s == nil){
		*term = existenceerror(L"stream", stream);
		return 1;
	}
	*term = parse(0, s->bio, 1);
	*term = parse(s->bio, mod);

	return 0;
}