shithub: pprolog

ref: 13efe91101a11f41caf6321a8b2fbdd96ef9927a
dir: /module.c/

#include <u.h>
#include <libc.h>
#include <bio.h>

#include "dat.h"
#include "fns.h"

void handleopdirective(Term *, Module *);

void
initmodules(void)
{
	addemptymodule(L"user");
	if(!addtousermod("/sys/lib/prolog/system.pl")){
		print("Can't load /sys/lib/prolog/system.pl\n");
		exits(nil);
	}
	if(!addtousermod("/sys/lib/prolog/loader.pl")){
		print("Can't load /sys/lib/prolog/loader.pl\n");
		exits(nil);
	}
}

int
addtousermod(char *file)
{
	Biobuf *bio = Bopen(file, OREAD);
	if(bio == nil)
		return 0;

	Module *usermodule = getmodule(L"user");
	Predicate *currentpred = nil;

	Term *t;
	VarName *varnames;
	while(t = parse(bio, usermodule, &varnames)){
		Clause *cl = gmalloc(sizeof(Clause));
		int arity;
		cl->clausenr = 0;
		cl->next = nil;
		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{
			cl->head = t;
			cl->body = mkatom(L"true");
		}
		if(cl->head->tag == AtomTerm)
			arity = 0;
		else
			arity = cl->head->arity;

		/* Figure out if this clause goes into the latest predicate, or if it is the start of a new one */
		if(currentpred == nil || runestrcmp(cl->head->text, currentpred->name) != 0 || arity != currentpred->arity){
			usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);
			currentpred = gmalloc(sizeof(Predicate));
			currentpred->name = cl->head->text;
			currentpred->arity = arity;
			currentpred->clauses = cl;
			currentpred->public = 1; /* everything is public for now */
			currentpred->builtin = 0;
			currentpred->dynamic = 1; /* everything is dynamic for now */
			currentpred->next = nil;
		}else
			currentpred->clauses = appendclause(currentpred->clauses, cl);
	}
	usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);

	Bterm(bio);
	return 1;
}

Module *
getmodule(Rune *name)
{
	Module *m;
	for(m = modules; m != nil; m = m->next){
		if(runestrcmp(m->name, name) == 0)
			return m;
	}
	return nil;
}

Module *
addemptymodule(Rune *name)
{
	Module *m = gmalloc(sizeof(Module));
	m->name = name;
	m->next = modules;
	m->predicates = nil;
	memset(m->operators, 0, sizeof(m->operators));

	Module *systemmodule = getmodule(L"system");
	if(systemmodule != nil){
		int level;
		Operator *op;
		for(level = 0; level < PrecedenceLevels; level++){
			for(op = systemmodule->operators[level]; op != nil; op = op->next)
				addoperator(op->level, op->type, op->spelling, m);
		}
	}
	modules = m;
	return m;
}

void
removemodule(Rune *name)
{
	Module *m;
	Module *prev = nil;
	for(m = modules; m != nil; m = m->next){
		if(runestrcmp(m->name, name) != 0)
			prev = m;
		else{
			if(prev == nil)
				modules = m->next;
			else
				prev->next = m->next;
			return;
		}
	}
}

Clause *
appendclause(Clause *clauses, Clause *new)
{
	Clause *tmp;

	if(clauses == nil)
		return new;

	for(tmp = clauses; tmp->next != nil; tmp = tmp->next);

	tmp->next = new;
	return clauses;
}

Predicate *
appendpredicate(Predicate *preds, Predicate *new)
{
	Predicate *tmp;

	if(preds == nil)
		return new;

	for(tmp = preds; tmp->next != nil; tmp = tmp->next);

	tmp->next = new;
	return preds;
}

Operator *
getoperator(Rune *spelling, Module *mod)
{
	Operator *op = nil;
	int level;

	if(spelling == nil || mod == nil)
		return nil;

	for(level = 0; level < PrecedenceLevels && op == nil; level++){
		Operator *tmp;
		for(tmp = mod->operators[level]; tmp != nil; tmp = tmp->next){
			if(runestrcmp(tmp->spelling, spelling) == 0){
				if(op == nil){
					op = gmalloc(sizeof(Operator));
					memcpy(op, tmp, sizeof(Operator));
				}else
					op->type |= tmp->type;
			}
		}
	}
	return op;
}

void
addoperator(int level, int type, Rune *spelling, Module *mod)
{
	if(mod == nil)
		return;

	/* the operator table is never garbage collected, so just use normal malloc */
	Operator *op = malloc(sizeof(Operator));
	op->type = type;
	op->level = level;
	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));
}