diff options
| -rw-r--r-- | builtins.c | 54 | ||||
| -rw-r--r-- | dat.h | 4 | ||||
| -rw-r--r-- | eval.c | 11 | ||||
| -rw-r--r-- | fns.h | 3 | ||||
| -rw-r--r-- | loader.pl | 44 | ||||
| -rw-r--r-- | main.c | 9 | ||||
| -rw-r--r-- | mkfile | 2 | ||||
| -rw-r--r-- | module.c | 86 | ||||
| -rw-r--r-- | parser.c | 23 | ||||
| -rw-r--r-- | prettyprint.c | 2 | ||||
| -rw-r--r-- | system.pl (renamed from stdlib.pl) | 16 |
11 files changed, 121 insertions, 133 deletions
@@ -10,7 +10,7 @@ #define Throw(What) do{\ Goal *g = gmalloc(sizeof(Goal)); \ g->goal = What; \ - g->module = usermodule; \ + g->module = getmodule(L"user"); \ g->catcher = nil; \ g->next = goalstack; \ goalstack = g; \ @@ -63,13 +63,14 @@ BuiltinProto(builtinputchar); BuiltinProto(builtincharcode); BuiltinProto(builtinchoicestacksize); BuiltinProto(builtincollectgarbage); -BuiltinProto(builtinloadmodulefromfile); BuiltinProto(builtinflushoutput); BuiltinProto(builtinstreamproperties); BuiltinProto(builtinsetstreamposition); BuiltinProto(builtinop); BuiltinProto(builtincurrentops); BuiltinProto(builtinnewemptymodule); +BuiltinProto(builtindeletemodule); +BuiltinProto(builtinactivatesystemmodule); BuiltinProto(builtinhalt); int compareterms(Term *, Term *); @@ -186,8 +187,6 @@ findbuiltin(Term *goal) return builtinchoicestacksize; if(Match(L"$collect_garbage", 0)) return builtincollectgarbage; - if(Match(L"$load_module_from_file", 1)) - return builtinloadmodulefromfile; if(Match(L"flush_output", 1)) return builtinflushoutput; if(Match(L"stream_properties", 1)) @@ -200,6 +199,10 @@ findbuiltin(Term *goal) return builtincurrentops; if(Match(L"$new_empty_module", 1)) return builtinnewemptymodule; + if(Match(L"$delete_module", 1)) + return builtindeletemodule; + if(Match(L"$activate_system_module", 0)) + return builtinactivatesystemmodule; if(Match(L"$halt", 1)) return builtinhalt; @@ -1492,27 +1495,6 @@ builtincollectgarbage(Term *goal, Binding **bindings, Module *module) } int -builtinloadmodulefromfile(Term *goal, Binding **bindings, Module *module) -{ - USED(bindings); - USED(module); - Term *file = goal->children; - - if(file->tag == VariableTerm) - Throw(instantiationerror()); - if(file->tag != AtomTerm) - Throw(typeerror(L"atom", file)); - - char *filestr = smprint("%S", file->text); - Module *m = parsemodule(filestr); - free(filestr); - if(m) - return 1; - else - return 0; -} - -int builtinflushoutput(Term *goal, Binding **bindings, Module *module) { USED(bindings); @@ -1574,7 +1556,7 @@ builtinop(Term *goal, Binding **bindings, Module *module) Term *specifier = priority->next; Term *operator = specifier->next; - if(runestrcmp(operator->text, L",") == 0) + if(runestrcmp(operator->text, L",") == 0 && runestrcmp(module->name, L"system") != 0) Throw(permissionerror(L"modify", L"operator", operator)); int type = 0; @@ -1654,6 +1636,26 @@ builtinnewemptymodule(Term *goal, Binding **bindings, Module *module) } int +builtindeletemodule(Term *goal, Binding **bindings, Module *module) +{ + USED(bindings); + USED(module); + Rune *name = goal->children->text; + removemodule(name); + return 1; +} + +int +builtinactivatesystemmodule(Term *goal, Binding **bindings, Module *module) +{ + USED(bindings); + USED(module); + USED(goal); + systemmoduleloaded = 1; + return 1; +} + +int builtinhalt(Term *goal, Binding **bindings, Module *module) { USED(bindings); @@ -154,7 +154,5 @@ int flagdoublequotes; Choicepoint *choicestack; 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 */ uvlong clausenr; - +int systemmoduleloaded; /* Is the module "system" ready to be used */ @@ -14,7 +14,7 @@ int evalquery(Term *query) { Binding *replbindings = nil; - goalstack = addgoals(goalstack, query, usermodule); + goalstack = addgoals(goalstack, query, getmodule(L"user")); while(goalstack->goal != nil){ Term *goal = goalstack->goal; @@ -45,6 +45,15 @@ evalquery(Term *query) }else{ Predicate *pred = findpredicate(module->predicates, goal); if(pred == nil){ + /* To to find it in the system module */ + Module *sysmod; + if(systemmoduleloaded) + sysmod = getmodule(L"system"); + else + sysmod = getmodule(L"user"); + pred = findpredicate(sysmod->predicates, goal); + } + if(pred == nil){ Rune *name; int arity; Term *replacement = nil; @@ -69,9 +69,10 @@ void reposition(Term *, vlong); /* module.c */ void initmodules(void); -Module *parsemodule(char *); +int addtousermod(char *); Module *getmodule(Rune *); Module *addemptymodule(Rune *); +void removemodule(Rune *); Clause *appendclause(Clause *, Clause *); Predicate *appendpredicate(Predicate *, Predicate *); Operator *getoperator(Rune *, Module *); @@ -1,14 +1,29 @@ :- module(loader, []). start(Args) :- - catch((load_module_from_file('/sys/lib/prolog/repl.pl'), ReplLoaded = true), E, (print_exception(E), ReplLoaded = false)), - !, - ( ReplLoaded = true - -> repl:repl(Args) + ( bootstrap([system, loader, repl]) + -> call(repl:repl(Args)) + ; write('Booting pprolog failed..'), halt ). -print_exception(E) :- - write('Caught exception while loading /sys/lib/prolog/repl.pl: '), +bootstrap([]) :- '$delete_module'(user), '$new_empty_module'(user). +bootstrap([Mod|Mods]) :- + system_mod_path(Mod, File), + catch(load_module_from_file(File), E, (print_exception(File, E), fail)), + ( Mod == system + -> '$activate_system_module' + ; true + ), + bootstrap(Mods). + +system_mod_path(Mod, Path) :- + atom_concat('/sys/lib/prolog/', Mod, Path0), + atom_concat(Path0, '.pl', Path). + +print_exception(File, E) :- + write('Caught exception while loading '), + write(File), + write(': '), write(E), nl. @@ -25,7 +40,8 @@ load_module_from_file(File) :- run_initialization_goals(Module) :- ( retract(initialization_goals(Module, Goal)), catch(Module:Goal, E, print_initialization_goal_error(Module, Goal, E)), - fail % Backtrack to find more goals + !, + run_initialization_goals(Module) ; true ). @@ -89,7 +105,7 @@ handle_term(Head, Singles, Module, Module) :- handle_clause(Head, Body, Singletons, Module) :- functor(Head, Name, Arity), PredicateIndicator = Name / Arity, - warn_singletons(PredicateIndicator, Singletons), + warn_singletons(PredicateIndicator, Module, Singletons), Module:'$insert_clause'(Head :- Body). handle_directive(dynamic(PI), Module, Module) :- @@ -125,15 +141,17 @@ handle_directive(D, Module, Module) :- write(D), nl. -warn_singletons(_, []). -warn_singletons(PI, Singles) :- - write('Warning: singleton variables in '), - write(PI), - write(': '), +warn_singletons(_, Module, []). +warn_singletons(PI, Module, Singles) :- + write('Warning: singleton variables '), write(Singles), + write(' in '), + write(Module:PI), write('.'), nl. + +:- dynamic(ensure_loads/1). ensure_loads(_) :- fail. ensure_load(F) :- @@ -11,7 +11,6 @@ void repl(int, char **); void main(int argc, char *argv[]) { - clausenr = 2; /* Start at two since 0 is for the facts in the database, and 1 is for queries */ initflags(); initstreams(); initmodules(); @@ -37,10 +36,6 @@ repl(int argc, char *argv[]) argc--; } args = mklist(args); - Term *mod = mkatom(L"loader"); - Term *pred = mkcompound(L"start", 1, args); - - mod->next = pred; - Term *goal = mkcompound(L":", 2, mod); - evalquery(goal); + Term *start = mkcompound(L"start", 1, args); + evalquery(start); }
\ No newline at end of file @@ -22,7 +22,7 @@ HFILES=dat.h fns.h BIN=/$objtype/bin PROLOGFILES=\ - stdlib.pl\ + system.pl\ repl.pl\ loader.pl @@ -8,55 +8,29 @@ void initmodules(void) { - systemmodule = parsemodule("/sys/lib/prolog/stdlib.pl"); - if(systemmodule == nil){ - print("Can't load /sys/lib/prolog/stdlib.pl\n"); + addemptymodule(L"user"); + if(!addtousermod("/sys/lib/prolog/system.pl")){ + print("Can't load /sys/lib/prolog/system.pl\n"); exits(nil); } - - Predicate *p; - for(p = systemmodule->predicates; p != nil; p = p->next){ - p->builtin = 1; - p->dynamic = 0; + if(!addtousermod("/sys/lib/prolog/loader.pl")){ + print("Can't load /sys/lib/prolog/loader.pl\n"); + exits(nil); } - - usermodule = addemptymodule(L"user"); - parsemodule("/sys/lib/prolog/loader.pl"); } -Module * -parsemodule(char *file) +int +addtousermod(char *file) { - Module *m = nil; - int fd = open(file, OREAD); if(fd < 0) - return nil; + return 0; + Module *usermodule = getmodule(L"user"); 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, nil)); - return nil; - } - if(flagdebug) - print("Public list for module '%S': %S\n", modulename->text, prettyprint(publiclist, 0, 0, 0, nil)); - m = getmodule(modulename->text); - } - terms = terms->next; - } + return 0; Predicate *currentpred = nil; Term *t; @@ -79,10 +53,7 @@ parsemodule(char *file) /* Figure out if this clause goes into the latest predicate, or if it is the start of a new one */ if(currentpred == nil || runestrcmp(cl->head->text, currentpred->name) != 0 || arity != currentpred->arity){ - if(m) - m->predicates = appendpredicate(currentpred, m->predicates); - else - usermodule->predicates = appendpredicate(currentpred, usermodule->predicates); + usermodule->predicates = appendpredicate(currentpred, usermodule->predicates); currentpred = gmalloc(sizeof(Predicate)); currentpred->name = cl->head->text; currentpred->arity = arity; @@ -94,12 +65,8 @@ parsemodule(char *file) }else currentpred->clauses = appendclause(currentpred->clauses, cl); } - if(m) - m->predicates = appendpredicate(currentpred, m->predicates); - else - usermodule->predicates = appendpredicate(currentpred, usermodule->predicates); - - return m; + usermodule->predicates = appendpredicate(currentpred, usermodule->predicates); + return 1; } Module * @@ -119,12 +86,11 @@ addemptymodule(Rune *name) Module *m = gmalloc(sizeof(Module)); m->name = name; m->next = modules; + m->predicates = nil; memset(m->operators, 0, sizeof(m->operators)); - if(systemmodule == nil) - m->predicates = nil; - else{ - m->predicates = systemmodule->predicates; /* Direct access to system clauses for now, but when I figure out imports this will change */ + Module *systemmodule = getmodule(L"system"); + if(systemmodule != nil){ int level; Operator *op; for(level = 0; level < PrecedenceLevels; level++){ @@ -136,6 +102,24 @@ addemptymodule(Rune *name) return m; } +void +removemodule(Rune *name) +{ + Module *m; + Module *prev = nil; + for(m = modules; m != nil; m = m->next){ + if(runestrcmp(m->name, name) != 0) + prev = m; + else{ + if(prev == nil) + modules = m->next; + else + prev->next = m->next; + return; + } + } +} + Clause * appendclause(Clause *clauses, Clause *new) { @@ -70,7 +70,7 @@ parse(int fd, Biobuf *bio, int querymode) parsein = bio; nexttoken(); - currentmod = usermodule; + currentmod = getmodule(L"user"); Term *result = prologtext(querymode); if(querymode && result){ @@ -101,12 +101,7 @@ prologtext(int querymode) if(t->tag == CompoundTerm && runestrcmp(t->text, L":-") == 0 && t->arity == 1){ Term *body = t->children; - if(runestrcmp(body->text, L"module") == 0 && body->arity == 2){ - handlemoduledirective(body->children); - t->next = prologtext(querymode); - return t; - } - else if(runestrcmp(body->text, L"op") == 0 && body->arity == 3) + if(runestrcmp(body->text, L"op") == 0 && body->arity == 3) handleopdirective(body->children); t = prologtext(querymode); @@ -579,20 +574,6 @@ syntaxerror_parser(char *where) } void -handlemoduledirective(Term *args) -{ - Term *modulename = args; - Term *publiclist = modulename->next; - USED(publiclist); - - if(modulename->tag != AtomTerm){ - print("Module name should be an atom in: %S\n", prettyprint(modulename, 0, 0, 0, currentmod)); - return; - } - currentmod = addemptymodule(modulename->text); -} - -void handleopdirective(Term *args) { Term *levelt = args; diff --git a/prettyprint.c b/prettyprint.c index ec00583..b980f1e 100644 --- a/prettyprint.c +++ b/prettyprint.c @@ -16,7 +16,7 @@ prettyprint(Term *t, int quoted, int ignoreops, int numbervars, Module *mod) Rune *result; Rune *args; if(mod == nil) - mod = usermodule; + mod = getmodule(L"user"); switch(t->tag){ case CompoundTerm: @@ -344,21 +344,21 @@ atomic(T) :- atom(T) ; integer(T) ; float(T). % type assertions (throws an error if false) -is_atom(T) :- atom(T), ! ; type_error(atom, T). +is_atom(T) :- (atom(T) ; type_error(atom, T)), !. -is_atom_or_var(T) :- (atom(T) ; var(T)), ! ; type_error(atom, T). +is_atom_or_var(T) :- (atom(T) ; var(T) ; type_error(atom, T)), !. -is_callable(T) :- callable(T), ! ; type_error(callable, T). +is_callable(T) :- (callable(T) ; type_error(callable, T)), !. -is_nonvar(T) :- nonvar(T), ! ; instantiation_error. +is_nonvar(T) :- (nonvar(T) ; instantiation_error), !. -is_list_or_partial_list(T) :- (list(T) ; partial_list(T)), ! ; type_error(list, T). +is_list_or_partial_list(T) :- (list(T) ; partial_list(T) ; type_error(list, T)), !. -is_list(T) :- list(T), ! ; type_error(list, T). +is_list(T) :- (list(T) ; type_error(list, T)), !. -is_integer(T) :- integer(T), ! ; type_error(integer, T). +is_integer(T) :- (integer(T) ; type_error(integer, T)), !. -is_predicate_indicator(T) :- (nonvar(T), T = N/A, integer(A), atom(N), !) ; type_error(predicate_indicator, T). +is_predicate_indicator(T) :- ((nonvar(T), T = N/A, integer(A), atom(N)) ; type_error(predicate_indicator, T)), !. % All solutions |