Add clause/2 predicate

1 files changed, 52 insertions, 0 deletions

diff --git a/builtins.c b/builtins.c
index 5e1dc58..bebf0d1 100644
--- a/builtins.c
+++ b/builtins.c
@@ -47,6 +47,7 @@ BuiltinProto(builtinsetoutput);
 BuiltinProto(builtinreadterm);
 BuiltinProto(builtinwriteterm);
 BuiltinProto(builtingeq);
+BuiltinProto(builtinclause);
 
 int compareterms(Term *, Term *);
 
@@ -130,6 +131,8 @@ findbuiltin(Term *goal)
 		return builtinwriteterm;
 	if(Match(L">=", 2))
 		return builtingeq;
+	if(Match(L"clause", 3))
+		return builtinclause;
 
 	return nil;
 }
@@ -808,4 +811,53 @@ builtingeq(Term *goal, Binding **bindings, Module *module)
 		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