shithub: pprolog

ref: 81fa4d4a176b5e330ffe20b2ed9f92b10ffc5ba9
dir: /module.c/

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

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

Module *addemptymodule(Rune *);

void
initmodules(void)
{
	systemmodule = parsemodule("./stdlib.pl");
	if(systemmodule == nil){
		print("Can't load ./stdlib.pl\n");
		exits(nil);
	}

	Predicate *p;
	for(p = systemmodule->predicates; p != nil; p = p->next){
		p->builtin = 1;
		p->dynamic = 0;
	}

	usermodule = addemptymodule(L"user");
}

Module *
parsemodule(char *file)
{
	Module *m = nil;

	int fd = open(file, OREAD);
	if(fd < 0)
		return nil;
	Term *terms = parse(fd, nil, 0);

	if(terms == nil)
		return nil;

	/* Actually look at the terms and convert ':-'/2 terms into clauses.
	   The only directives (terms of type ':-'/1 there should be in the list are
	   the module specific ones, as the other are handled by parse itself.
	*/
	if(terms->tag == CompoundTerm && runestrcmp(terms->text, L":-") == 0 && terms->arity == 1){
		Term *directive = terms->children;
		if(directive->tag == CompoundTerm && runestrcmp(directive->text, L"module") == 0 && directive->arity == 2){
			Term *modulename = directive->children;
			Term *publiclist = modulename->next;
			if(modulename->tag != AtomTerm){
				print("Module name should be an atom in: %S\n", prettyprint(directive, 0, 0, 0));
				return nil;
			}
			print("Public list for module '%S': %S\n", modulename->text, prettyprint(publiclist, 0, 0, 0));
			m = addemptymodule(modulename->text);
		}
		terms = terms->next;
	}

	Predicate *currentpred = nil;
	Term *t;
	for(t = terms; t != nil; t = t->next){
		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){
			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){
			if(m)
				m->predicates = appendpredicate(currentpred, m->predicates);
			else
				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);
	}
	if(m)
		m->predicates = appendpredicate(currentpred, m->predicates);
	else
		usermodule->predicates = appendpredicate(currentpred, usermodule->predicates);

	return m;
}

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;

	if(systemmodule == nil)
		m->predicates = nil;
	else
		m->predicates = systemmodule->predicates; /* Direct access to system clauses for now, but when I figure out imports this will change */
	modules = m;
	return m;
}

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