shithub: pprolog

Info  •  Files  •  Log

Add clause/2 predicate

--- a/builtins.c

+++ b/builtins.c

@@ -47,6 +47,7 @@

 BuiltinProto(builtinreadterm);

 BuiltinProto(builtinwriteterm);

 BuiltinProto(builtingeq);

+BuiltinProto(builtinclause);

 int compareterms(Term *, Term *);

@@ -130,6 +131,8 @@

 		return builtinwriteterm;

 	if(Match(L">=", 2))

 		return builtingeq;

+	if(Match(L"clause", 3))

+		return builtinclause;

 	return nil;

 }

@@ -808,4 +811,53 @@

 		return aval->dval >= bval->ival;

 	else

 		return 0;

+}

+

+int

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

+{

+	Term *head = goal->children;

+	Term *body = head->next;

+	Term *clauselist = body->next;

+	

+	if(head->tag == VariableTerm)

+		Throw(instantiationerror());

+	if(head->tag != AtomTerm && head->tag != CompoundTerm)

+		Throw(typeerror(L"callable", head));

+	if(body->tag != VariableTerm && body->tag != AtomTerm && body->tag != CompoundTerm)

+		Throw(typeerror(L"callable", body));

+	if(clauselist->tag != VariableTerm)

+		Throw(typeerror(L"variable", clauselist));

+

+	print("Attempting to find clauses in module %S where head unifies with %S\n", module->name, prettyprint(head, 0, 0, 0));

+

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

+	if(pred == nil)

+		return 0;

+

+	Term *functor = mkatom(pred->name);

+	functor->next = mkinteger(pred->arity);

+	Term *pi = mkcompound(L"/", 2, functor);

+	if(!pred->public)

+		Throw(permissionerror(L"access", L"private_procedure", pi));

+

+	Term *realclauses = nil;

+	Clause *c = pred->clauses;

+	while(c != nil){

+		Binding *bs = nil;

+		c = findclause(c, head, &bs);

+		if(c != nil){

+			/* Append the clause to the realclauselist */

+			Term *cl = c->head;

+			if(c->body)

+				cl->next = c->body;

+			else

+				cl->next = mkatom(L"true");

+			

+			realclauses = appendterm(realclauses, mkcompound(L"clause", 2, cl));

+			c = c->next;

+		}

+	}

+	Term *realclauselist = mklist(realclauses);

+	return unify(clauselist, realclauselist, bindings);

 }

\ No newline at end of file

--- a/dat.h

+++ b/dat.h

@@ -51,7 +51,6 @@

 	Term *head;

 	Term *body;

 	uvlong clausenr;

-	int public;

 	Clause *next;

 };

@@ -59,6 +58,7 @@

 {

 	Rune *name;

 	int arity;

+	int public;

 	Clause *clauses;

 	Predicate *next;

 };

--- a/eval.c

+++ b/eval.c

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

 #include "dat.h"

 #include "fns.h"

-Predicate *findpredicate(Predicate *, Term *);

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

 int equalterms(Term *, Term *);

 Goal *copygoals(Goal *);

 Builtin findbuiltin(Term *);

@@ -142,9 +140,6 @@

 {

 	Clause *clause;

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

-		if(!clauses->public)

-			continue;

-

 		clause = copyclause(clauses, &clausenr);

 		clausenr++;

 		clause->next = clauses->next;

@@ -209,6 +204,7 @@

 			b->value = right;

 			b->next = *bindings;

 			*bindings = b;

+

 			Term *t;

 			for(t = leftstack; t != nil; t = t->next)

 				applybinding(t, b);

--- a/fns.h

+++ b/fns.h

@@ -22,6 +22,8 @@

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

 void applybinding(Term *, Binding *);

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

+Predicate *findpredicate(Predicate *, Term *);

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

 /* repl.c */

 void repl(void);

--- a/lists.pl

+++ b/lists.pl

@@ -7,10 +7,6 @@

 	length(Tail, Length0),

 	Length is Length0 + 1.

-member(X, [X|_]).

-member(X, [_|Tail]) :-

-	member(X, Tail).

-

 append([], Ys, Ys).

 append([X|Xs], Ys, [X|Rest]) :-

 	append(Xs, Ys, Rest).

--- a/misc.c

+++ b/misc.c

@@ -152,7 +152,6 @@

 		new->clausenr = *clausenr;

 	else

 		new->clausenr = orig->clausenr;

-	new->public = orig->public;

 	new->next = nil;

 	return new;

 }

\ No newline at end of file

--- a/module.c

+++ b/module.c

@@ -59,7 +59,6 @@

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

 		int arity;

 		cl->clausenr = 0;

-		cl->public = 1; /* everything is public for now */

 		cl->next = nil;

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

 			cl->head = t->children;

@@ -83,6 +82,7 @@

 			currentpred->name = cl->head->text;

 			currentpred->arity = arity;

 			currentpred->clauses = cl;

+			currentpred->public = 1; /* everything is public for now */

 			currentpred->next = nil;

 		}else

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

--- a/stdlib.pl

+++ b/stdlib.pl

@@ -150,3 +150,13 @@

 	E2 < E1.

+% Clause retrieval and information

+

+clause(Head, Body) :-

+	clause(Head, Body, Clauses),

+	member(clause(Head, Body), Clauses).

+

+% Basic list predicates

+member(X, [X|_]).

+member(X, [_|Tail]) :-

+	member(X, Tail).