diff options
| -rw-r--r-- | TODO | 2 | ||||
| -rw-r--r-- | builtins.c | 89 | ||||
| -rw-r--r-- | dat.h | 32 | ||||
| -rw-r--r-- | eval.c | 72 | ||||
| -rw-r--r-- | example.pl | 2 | ||||
| -rw-r--r-- | fns.h | 12 | ||||
| -rw-r--r-- | main.c | 39 | ||||
| -rw-r--r-- | misc.c | 18 | ||||
| -rw-r--r-- | mkfile | 3 | ||||
| -rw-r--r-- | module.c | 116 | ||||
| -rw-r--r-- | parser.c | 12 | ||||
| -rw-r--r-- | repl.c | 4 | ||||
| -rw-r--r-- | stdlib.pl | 13 |
13 files changed, 266 insertions, 148 deletions
@@ -5,4 +5,4 @@ * Right now we copy and allocate a lot, but almost never free stuff. * Many builtins should really throw an error, but they just fail for now. * Exceptions (throw, catch) -* Modules +* Modules (I try to do something like SWI prolog for now, but I know there is also an iso standard)
\ No newline at end of file @@ -5,7 +5,7 @@ #include "dat.h" #include "fns.h" -#define BuiltinProto(name) int name(Term *, Term *, Binding **) +#define BuiltinProto(name) int name(Term *, Binding **) #define Match(X, Y) (runestrcmp(name, X) == 0 && arity == Y) #define Throw(What) do{\ Goal *g = malloc(sizeof(Goal)); \ @@ -128,18 +128,16 @@ findbuiltin(Term *goal) } int -builtinfail(Term *database, Term *goal, Binding **bindings) +builtinfail(Term *goal, Binding **bindings) { - USED(database); USED(goal); USED(bindings); return 0; } int -builtincall(Term *database, Term *goal, Binding **bindings) +builtincall(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Goal *g = malloc(sizeof(Goal)); @@ -152,9 +150,8 @@ builtincall(Term *database, Term *goal, Binding **bindings) } int -builtincut(Term *database, Term *goal, Binding **bindings) +builtincut(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Choicepoint *cp = choicestack; @@ -169,72 +166,64 @@ builtincut(Term *database, Term *goal, Binding **bindings) } int -builtinvar(Term *database, Term *goal, Binding **bindings) +builtinvar(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag == VariableTerm); } int -builtinatom(Term *database, Term *goal, Binding **bindings) +builtinatom(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag == AtomTerm); } int -builtininteger(Term *database, Term *goal, Binding **bindings) +builtininteger(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag == NumberTerm && arg->numbertype == NumberInt); } int -builtinfloat(Term *database, Term *goal, Binding **bindings) +builtinfloat(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag == NumberTerm && arg->numbertype == NumberFloat); } int -builtinatomic(Term *database, Term *goal, Binding **bindings) +builtinatomic(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag == AtomTerm || arg->tag == NumberTerm); } int -builtincompound(Term *database, Term *goal, Binding **bindings) +builtincompound(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag == CompoundTerm); } int -builtinnonvar(Term *database, Term *goal, Binding **bindings) +builtinnonvar(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag != VariableTerm); } int -builtinnumber(Term *database, Term *goal, Binding **bindings) +builtinnumber(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *arg = goal->children; return (arg->tag == NumberTerm); @@ -296,9 +285,8 @@ compareterms(Term *t1, Term *t2) } int -builtincompare(Term *database, Term *goal, Binding **bindings) +builtincompare(Term *goal, Binding **bindings) { - USED(database); Term *order = goal->children; Term *t1 = order->next; Term *t2 = t1->next; @@ -317,9 +305,8 @@ builtincompare(Term *database, Term *goal, Binding **bindings) } int -builtinfunctor(Term *database, Term *goal, Binding **bindings) +builtinfunctor(Term *goal, Binding **bindings) { - USED(database); Term *term = goal->children; Term *name = term->next; @@ -354,9 +341,8 @@ builtinfunctor(Term *database, Term *goal, Binding **bindings) } int -builtinarg(Term *database, Term *goal, Binding **bindings) +builtinarg(Term *goal, Binding **bindings) { - USED(database); Term *n = goal->children; Term *term = n->next; @@ -390,9 +376,8 @@ listlength(Term *term) } int -builtinuniv(Term *database, Term *goal, Binding **bindings) +builtinuniv(Term *goal, Binding **bindings) { - USED(database); Term *term = goal->children; Term *list = term->next; @@ -463,9 +448,8 @@ aritheval(Term *expr) } int -builtinis(Term *database, Term *goal, Binding **bindings) +builtinis(Term *goal, Binding **bindings) { - USED(database); Term *result = goal->children; Term *expr = result->next; @@ -478,9 +462,8 @@ builtinis(Term *database, Term *goal, Binding **bindings) } int -builtincatch(Term *database, Term *goal, Binding **bindings) +builtincatch(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *catchgoal = goal->children; @@ -503,9 +486,8 @@ builtincatch(Term *database, Term *goal, Binding **bindings) } int -builtinthrow(Term *database, Term *goal, Binding **bindings) +builtinthrow(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *ball = goal->children; @@ -543,18 +525,16 @@ builtinthrow(Term *database, Term *goal, Binding **bindings) } int -builtincurrentprologflag(Term *database, Term *goal, Binding **bindings) +builtincurrentprologflag(Term *goal, Binding **bindings) { - USED(database); USED(goal); USED(bindings); return 0; } int -builtinsetprologflag(Term *database, Term *goal, Binding **bindings) +builtinsetprologflag(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *key = goal->children; Term *value = key->next; @@ -572,9 +552,8 @@ builtinsetprologflag(Term *database, Term *goal, Binding **bindings) } int -builtinopen(Term *database, Term *goal, Binding **bindings) +builtinopen(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *sourcesink = goal->children; @@ -608,9 +587,8 @@ builtinopen(Term *database, Term *goal, Binding **bindings) } int -builtinclose(Term *database, Term *goal, Binding **bindings) +builtinclose(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *stream = goal->children; @@ -634,9 +612,8 @@ builtinclose(Term *database, Term *goal, Binding **bindings) } int -builtincurrentinput(Term *database, Term *goal, Binding **bindings) +builtincurrentinput(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *stream = goal->children; @@ -648,9 +625,8 @@ builtincurrentinput(Term *database, Term *goal, Binding **bindings) } int -builtincurrentoutput(Term *database, Term *goal, Binding **bindings) +builtincurrentoutput(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *stream = goal->children; @@ -662,9 +638,8 @@ builtincurrentoutput(Term *database, Term *goal, Binding **bindings) } int -builtinsetinput(Term *database, Term *goal, Binding **bindings) +builtinsetinput(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *stream = goal->children; @@ -685,9 +660,8 @@ builtinsetinput(Term *database, Term *goal, Binding **bindings) } int -builtinsetoutput(Term *database, Term *goal, Binding **bindings) +builtinsetoutput(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *stream = goal->children; @@ -708,9 +682,8 @@ builtinsetoutput(Term *database, Term *goal, Binding **bindings) } int -builtinreadterm(Term *database, Term *goal, Binding **bindings) +builtinreadterm(Term *goal, Binding **bindings) { - USED(database); USED(bindings); Term *stream = goal->children; @@ -739,11 +712,10 @@ builtinreadterm(Term *database, Term *goal, Binding **bindings) } int -builtinwriteterm(Term *database, Term *goal, Binding **bindings) +builtinwriteterm(Term *goal, Binding **bindings) { - USED(database); USED(bindings); - + Term *stream = goal->children; Term *term = stream->next; Term *options = term->next; @@ -763,4 +735,3 @@ builtinwriteterm(Term *database, Term *goal, Binding **bindings) writeterm(stream, options, term); return 1; } - @@ -2,7 +2,9 @@ typedef struct Term Term; typedef struct Binding Binding; typedef struct Goal Goal; typedef struct Choicepoint Choicepoint; -typedef int (*Builtin)(Term *, Term *, Binding **); +typedef struct Clause Clause; +typedef struct Module Module; +typedef int (*Builtin)(Term *, Binding **); struct Term { @@ -36,11 +38,29 @@ struct Goal struct Choicepoint { Goal *goalstack; - Term *retryclause; + Clause *retryclause; uvlong id; /* Unique number for each clause. Used to know where to cut to. */ + Module *currentmodule; Choicepoint *next; }; +struct Clause +{ + Term *head; + Term *body; + uvlong clausenr; + int public; + Clause *next; +}; + +struct Module +{ + /* What about imports */ + Rune *name; + Clause *clauses; + Module *next; +}; + /* Sorted so that a lower value means it comes earlier in the standard ordering */ enum { VariableTerm, @@ -55,7 +75,6 @@ enum { }; int debug; -Term *initgoals; /* Flags */ enum { @@ -66,6 +85,9 @@ enum { int flagdoublequotes; -/* Staate of the running system */ +/* State of the running system */ Choicepoint *choicestack; -Goal *goalstack;
\ No newline at end of file +Goal *goalstack; +Module *modules; +Module *systemmodule; /* The module for the builtins. Everything has access to those */ +Module *usermodule; /* The default module for user defined predicates */ @@ -6,7 +6,7 @@ #include "fns.h" Goal *addgoals(Goal *, Term *); -Term *findclause(Term *, Term *, Binding **); +Clause *findclause(Clause *, Term *, Binding **); int equalterms(Term *, Term *); Goal *copygoals(Goal *); Builtin findbuiltin(Term *); @@ -14,8 +14,9 @@ Builtin findbuiltin(Term *); static uvlong clausenr; int -evalquery(Term *database, Term *query, Binding **resultbindings) +evalquery(Term *query, Binding **resultbindings) { + static Module *currentmodule = nil; if(choicestack == nil){ /* The goal stack has the original query at the very bottom, protected by a catch frame where the ->goal field is nil. @@ -37,42 +38,60 @@ evalquery(Term *database, Term *query, Binding **resultbindings) goalstack = addgoals(goalstack, query); clausenr = 2; /* Start at two since 0 is for the facts in the database, and 1 is for queries */ + + currentmodule = usermodule; }else{ goto Backtrack; } while(goalstack->goal != nil){ - Term *dbstart; + Clause *startclause; Term *goal; Goal *oldgoalstack; - dbstart = database; + startclause = nil; /* Where to start looking for a matching clause. Used by backtracking */ Retry: - print("Loop run\n"); goal = goalstack->goal; oldgoalstack = goalstack; goalstack = goalstack->next; - if(oldgoalstack->catcher){ - print("Was catchframe\n"); + if(oldgoalstack->catcher) continue; - } if(debug) print("Working goal: %S\n", prettyprint(goal, 0, 0, 0)); + if(startclause == nil && goal->tag == CompoundTerm && goal->arity == 2 && runestrcmp(goal->text, L":") == 0){ + Term *module = goal->children; + if(module->tag == AtomTerm){ + Module *m = getmodule(module->text); + if(m == nil) + goal = existenceerror(L"module", module); + else{ + goal = module->next; + currentmodule = m; + startclause = m->clauses; + oldgoalstack->goal = goal; + } + }else + goal = typeerror(L"module", module); + } + + if(startclause == nil) + startclause = currentmodule->clauses; + Binding *bindings = nil; - Term *clause = nil; + Clause *clause = nil; /* Try to see if the goal can be solved using a builtin first */ Builtin builtin = findbuiltin(goal); if(builtin != nil){ - int success = builtin(database, goal, &bindings); + int success = builtin(goal, &bindings); if(!success) goto Backtrack; }else{ /* Find a clause where the head unifies with the goal */ - clause = findclause(dbstart, goal, &bindings); + clause = findclause(startclause, goal, &bindings); if(clause != nil){ if(clause->next != nil){ /* Add a choicepoint. Note we create a choicepoint every time, so there is room for improvement. */ @@ -81,6 +100,7 @@ Retry: cp->next = choicestack; cp->retryclause = clause->next; cp->id = clause->clausenr; + cp->currentmodule = currentmodule; choicestack = cp; } }else{ @@ -93,7 +113,8 @@ Backtrack: choicestack = cp->next; /* freegoals(goals) */ goalstack = cp->goalstack; - dbstart = cp->retryclause; + currentmodule = cp->currentmodule; + startclause = cp->retryclause; goto Retry; } } @@ -106,8 +127,8 @@ Backtrack: } /* Add clause body as goals, with bindings applied */ - if(clause != nil && clause->tag == CompoundTerm && clause->arity == 2 && runestrcmp(clause->text, L":-") == 0){ - Term *subgoal = copyterm(clause->children->next, nil); + if(clause != nil && clause->body != nil){ + Term *subgoal = copyterm(clause->body, nil); applybinding(subgoal, bindings); goalstack = addgoals(goalstack, subgoal); } @@ -133,21 +154,18 @@ addgoals(Goal *goals, Term *t) return goals; } -Term * -findclause(Term *database, Term *goal, Binding **bindings) +Clause * +findclause(Clause *clauses, Term *goal, Binding **bindings) { - Term *clause; - Term *head; - for(; database != nil; database = database->next){ - clause = copyterm(database, &clausenr); - clausenr++; - clause->next = database->next; - if(clause->tag == CompoundTerm && runestrcmp(clause->text, L":-") == 0 && clause->arity == 2) - head = clause->children; - else - head = clause; + Clause *clause; + for(; clauses != nil; clauses = clauses->next){ + if(!clauses->public) + continue; - if(unify(head, goal, bindings)) + clause = copyclause(clauses, &clausenr); + clausenr++; + clause->next = clauses->next; + if(unify(clause->head, goal, bindings)) return clause; } return nil; @@ -1,3 +1,5 @@ +:- module(example, []). + math(A,B,C,D) :- D is A + B + C * A. parentest :- @@ -14,14 +14,15 @@ Term *mkcompound(Rune *, int, Term *); Term *mknumber(int, vlong, double); Term *mkstring(Rune *); Term *mklist(Term *); +Clause *copyclause(Clause *, uvlong *); /* eval.c */ -int evalquery(Term *, Term *, Binding **); +int evalquery(Term *, Binding **); int unify(Term *, Term *, Binding **); void applybinding(Term *, Binding *); /* repl.c */ -void repl(Term *); +void repl(void); /* builtins.c */ Builtin findbuiltin(Term *); @@ -55,4 +56,9 @@ int isoutputstream(Term *); int istextstream(Term *); int isbinarystream(Term *); int readterm(Term *, Term *, Term **); -void writeterm(Term *, Term *, Term *);
\ No newline at end of file +void writeterm(Term *, Term *, Term *); + +/* module.c */ +void initmodules(void); +Module *parsemodule(char *); +Module *getmodule(Rune *);
\ No newline at end of file @@ -10,56 +10,31 @@ void usage(void); void main(int argc, char *argv[]) { - char *parsetestfile = nil; - ARGBEGIN{ case 'd': debug = 1; break; - case 'f': - parsetestfile = EARGF(usage()); - break; default: usage(); }ARGEND - if(argc != 0) - usage(); - initflags(); initstreams(); + initmodules(); - int fd = open("./stdlib.pl", OREAD); - if(fd < 0){ - print("Can't open ./stdlib.pl\n"); - exits("open"); + while(argc != 0){ + parsemodule(argv[0]); + argc--; + argv++; } - Term *database = parse(fd, nil, 0); - close(fd); - - if(parsetestfile){ - int fd = open(parsetestfile, OREAD); - if(fd < 0) - exits("open"); - Term *clauses = parse(fd, nil, 0); - database = appendterm(database, clauses); - - Term *goal; - for(goal = initgoals; goal != nil; goal = goal->next){ - Binding *bindings = nil; - evalquery(database, goal, &bindings); - } - } - - repl(database); - + repl(); exits(nil); } void usage(void) { - fprint(2, "Usage: pprolog [-d]\n"); + fprint(2, "Usage: pprolog [-d] modulefiles\n"); exits("Usage"); }
\ No newline at end of file @@ -132,3 +132,21 @@ mklist(Term *elems) return mkcompound(L".", 2, t); } } + +Clause * +copyclause(Clause *orig, uvlong *clausenr) +{ + Clause *new = malloc(sizeof(Clause)); + new->head = copyterm(orig->head, clausenr); + if(orig->body) + new->body = copyterm(orig->body, clausenr); + else + new->body = nil; + if(clausenr) + new->clausenr = *clausenr; + else + new->clausenr = orig->clausenr; + new->public = orig->public; + new->next = nil; + return new; +}
\ No newline at end of file @@ -12,7 +12,8 @@ OFILES=\ repl.$O\ flags.$O\ error.$O\ - streams.$O + streams.$O\ + module.$O HFILES=dat.h fns.h diff --git a/module.c b/module.c new file mode 100644 index 0000000..f3ab01b --- /dev/null +++ b/module.c @@ -0,0 +1,116 @@ +#include <u.h> +#include <libc.h> +#include <bio.h> + +#include "dat.h" +#include "fns.h" + +Module *addemptymodule(Rune *); +Clause *appendclause(Clause *, Clause *); + +void +initmodules(void) +{ + systemmodule = parsemodule("./stdlib.pl"); + if(systemmodule == nil){ + print("Can't load ./stdlib.pl\n"); + exits(nil); + } + + usermodule = addemptymodule(L"user"); +} + +Module * +parsemodule(char *file) +{ + Module *m = nil; + + int fd = open(file, OREAD); + if(fd < 0) + return nil; + Term *terms = parse(fd, nil, 0); + + if(terms == nil) + return nil; + + /* Actually look at the terms and convert ':-'/2 terms into clauses. + The only directives (terms of type ':-'/1 there should be in the list are + the module specific ones, as the other are handled by parse itself. + */ + if(terms->tag == CompoundTerm && runestrcmp(terms->text, L":-") == 0 && terms->arity == 1){ + Term *directive = terms->children; + if(directive->tag == CompoundTerm && runestrcmp(directive->text, L"module") == 0 && directive->arity == 2){ + Term *modulename = directive->children; + Term *publiclist = modulename->next; + if(modulename->tag != AtomTerm){ + print("Module name should be an atom in: %S\n", prettyprint(directive, 0, 0, 0)); + return nil; + } + print("Public list for module '%S': %S\n", modulename->text, prettyprint(publiclist, 0, 0, 0)); + m = addemptymodule(modulename->text); + } + terms = terms->next; + } + + Term *t; + for(t = terms; t != nil; t = t->next){ + Clause *cl = malloc(sizeof(Clause)); + 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; + cl->body = t->children->next; + }else{ + cl->head = t; + cl->body = nil; + } + + if(m == nil) + usermodule->clauses = appendclause(usermodule->clauses, cl); + else + m->clauses = appendclause(m->clauses, cl); + } + + return m; +} + +Module * +getmodule(Rune *name) +{ + Module *m; + for(m = modules; m != nil; m = m->next){ + if(runestrcmp(m->name, name) == 0) + return m; + } + return nil; +} + +Module * +addemptymodule(Rune *name) +{ + Module *m = malloc(sizeof(Module)); + m->name = name; + m->next = modules; + + if(systemmodule == nil) + m->clauses = nil; + else + m->clauses = systemmodule->clauses; /* Direct access to system clauses for now, but when I figure out imports this will change */ + modules = m; + return m; +} + +Clause * +appendclause(Clause *clauses, Clause *new) +{ + Clause *tmp; + + if(clauses == nil) + return new; + + for(tmp = clauses; tmp->next != nil; tmp = tmp->next); + + tmp->next = new; + return clauses; +}
\ No newline at end of file @@ -91,7 +91,6 @@ parse(int fd, Biobuf *bio, int querymode) }else parsein = bio; - initgoals = nil; initoperators(); nexttoken(); @@ -125,12 +124,10 @@ prologtext(int querymode) if(t->tag == CompoundTerm && runestrcmp(t->text, L":-") == 0 && t->arity == 1){ Term *body = t->children; print("Got directive: %S\n", prettyprint(body, 0, 0, 0)); - if(body->tag == CompoundTerm && body->arity == 1 && runestrcmp(body->text, L"initialization") == 0){ - Term *tmp = initgoals; - initgoals = body->children; - initgoals->next = tmp; - } - t = prologtext(querymode); + if(runestrcmp(body->text, L"module") == 0 && body->arity == 2) + t->next = prologtext(querymode); + else + t = prologtext(querymode); }else if(t->tag == CompoundTerm && runestrcmp(t->text, L":-") == 0 && t->arity == 2){ t->next = prologtext(querymode); }else if(t->tag == AtomTerm || t->tag == CompoundTerm){ @@ -391,6 +388,7 @@ initoperators(void) addoperator(700, Xfx, L">"); addoperator(700, Xfx, L">="); addoperator(700, Xfx, L"=.."); + addoperator(600, Xfy, L":"); addoperator(500, Yfx, L"+"); addoperator(400, Yfx, L"*"); addoperator(400, Yfx, L"/"); @@ -8,7 +8,7 @@ Rune parsefindmore(int); void -repl(Term *database) +repl(void) { int fd = 0; /* Standard input */ while(1){ @@ -19,7 +19,7 @@ repl(Term *database) goalstack = nil; /* should free old choicestack and goalstack */ int success; FindMore: - success = evalquery(database, query, &bindings); + success = evalquery(query, &bindings); if(success == 0) print("false.\n"); else{ @@ -1,3 +1,5 @@ +:- module(system, []). + % Logic and control predicates \+ Goal :- call(Goal), !, fail. \+ Goal. @@ -58,17 +60,6 @@ A @>= B :- A @>= B :- A @> B. -% List predicates - -length([], 0). -length([_|Tail], Length) :- - length(Tail, Length0), - Length is Length0 + 1. - -member(X, [X|_]). -member(X, [_|Tail]) :- - member(X, Tail). - % Input output open(SourceSink, Mode, Stream) :- |