Add current_predicate/1 builtin

1 files changed, 42 insertions, 0 deletions

diff --git a/builtins.c b/builtins.c
index 56576a8..6f5a6bf 100644
--- a/builtins.c
+++ b/builtins.c
@@ -48,6 +48,7 @@ BuiltinProto(builtinreadterm);
 BuiltinProto(builtinwriteterm);
 BuiltinProto(builtingeq);
 BuiltinProto(builtinclause);
+BuiltinProto(builtincurrentpredicate);
 
 int compareterms(Term *, Term *);
 
@@ -133,6 +134,8 @@ findbuiltin(Term *goal)
 		return builtingeq;
 	if(Match(L"clause", 3))
 		return builtinclause;
+	if(Match(L"current_predicate", 2))
+		return builtincurrentpredicate;
 
 	return nil;
 }
@@ -860,4 +863,43 @@ builtinclause(Term *goal, Binding **bindings, Module *module)
 	}
 	Term *realclauselist = mklist(realclauses);
 	return unify(clauselist, realclauselist, bindings);
+}
+
+int
+builtincurrentpredicate(Term *goal, Binding **bindings, Module *module)
+{
+	Term *pi = goal->children;
+	Term *list = pi->next;
+
+	if(pi->tag != VariableTerm && !ispredicateindicator(pi, 1))
+		Throw(typeerror(L"predicate_indicator", pi));
+
+	Rune *predname = nil;
+	int arity = -1;
+	if(ispredicateindicator(pi, 1)){
+		Term *functor = pi->children;
+		Term *arityterm = functor->next;
+		if(functor->tag == AtomTerm)
+			predname = functor->text;
+		if(arityterm->tag == IntegerTerm)
+			arity = arityterm->ival;
+	}
+
+	Term *pilist = nil;
+	Predicate *pred;
+	for(pred = module->predicates; pred != nil; pred = pred->next){
+		if(pred->builtin)
+			continue;
+		if(predname && runestrcmp(pred->name, predname) != 0)
+			continue;
+		if(arity != -1 && pred->arity != arity)
+			continue;
+
+		Term *functor = mkatom(pred->name);
+		functor->next = mkinteger(pred->arity);
+		Term *t = mkcompound(L"/", 2, functor);
+		pilist = appendterm(t, pilist);
+	}
+	Term *reallist = mklist(pilist);
+	return unify(list, reallist, bindings);
 }
\ No newline at end of file