diff options
| -rw-r--r-- | builtins.c | 52 | ||||
| -rw-r--r-- | dat.h | 2 | ||||
| -rw-r--r-- | eval.c | 6 | ||||
| -rw-r--r-- | fns.h | 2 | ||||
| -rw-r--r-- | lists.pl | 4 | ||||
| -rw-r--r-- | misc.c | 1 | ||||
| -rw-r--r-- | module.c | 2 | ||||
| -rw-r--r-- | stdlib.pl | 10 |
8 files changed, 67 insertions, 12 deletions
@@ -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 @@ -51,7 +51,6 @@ struct Clause Term *head; Term *body; uvlong clausenr; - int public; Clause *next; }; @@ -59,6 +58,7 @@ struct Predicate { Rune *name; int arity; + int public; Clause *clauses; Predicate *next; }; @@ -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 @@ findclause(Clause *clauses, Term *goal, Binding **bindings) { 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 @@ unify(Term *a, Term *b, Binding **bindings) b->value = right; b->next = *bindings; *bindings = b; + Term *t; for(t = leftstack; t != nil; t = t->next) applybinding(t, b); @@ -22,6 +22,8 @@ int evalquery(Term *, Binding **); 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); @@ -7,10 +7,6 @@ length([_|Tail], Length) :- 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). @@ -152,7 +152,6 @@ copyclause(Clause *orig, uvlong *clausenr) new->clausenr = *clausenr; else new->clausenr = orig->clausenr; - new->public = orig->public; new->next = nil; return new; }
\ No newline at end of file @@ -59,7 +59,6 @@ parsemodule(char *file) 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 @@ parsemodule(char *file) 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); @@ -150,3 +150,13 @@ E1 > E2 :- 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). |