summaryrefslogtreecommitdiff
path: root/builtins.c
diff options
context:
space:
mode:
Diffstat (limited to 'builtins.c')
-rw-r--r--builtins.c52
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