summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Mikkelsen <peter@pmikkelsen.com>2021-07-22 21:54:46 +0000
committerPeter Mikkelsen <peter@pmikkelsen.com>2021-07-22 21:54:46 +0000
commit48da622d4ad0b4acfe9005dd318ac3f20b4e8672 (patch)
tree9eed593702dc2fbd7f93689f53605241560f51e9
parent0f347162b74d945f509955b6c57e506ab800db7b (diff)
Big commit changing the way the system is loaded at startup.
1) The loader and system modules are loaded by the C directly into the user module 2) The system module is then loaded with the loader from the user module 3) The loader module is then loaded with the loader from the user module 4) The repl is then loaded with the loader from the loader module 5) The user module is cleared
-rw-r--r--builtins.c54
-rw-r--r--dat.h4
-rw-r--r--eval.c11
-rw-r--r--fns.h3
-rw-r--r--loader.pl44
-rw-r--r--main.c9
-rw-r--r--mkfile2
-rw-r--r--module.c86
-rw-r--r--parser.c23
-rw-r--r--prettyprint.c2
-rw-r--r--system.pl (renamed from stdlib.pl)16
11 files changed, 121 insertions, 133 deletions
diff --git a/builtins.c b/builtins.c
index 79c71f0..6dda64f 100644
--- a/builtins.c
+++ b/builtins.c
@@ -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);
diff --git a/dat.h b/dat.h
index 72a95b5..d6adb18 100644
--- a/dat.h
+++ b/dat.h
@@ -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 */
diff --git a/eval.c b/eval.c
index e57f28f..4391110 100644
--- a/eval.c
+++ b/eval.c
@@ -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;
diff --git a/fns.h b/fns.h
index f3d9ebd..e2785ac 100644
--- a/fns.h
+++ b/fns.h
@@ -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 *);
diff --git a/loader.pl b/loader.pl
index 99478d0..d688e46 100644
--- a/loader.pl
+++ b/loader.pl
@@ -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) :-
diff --git a/main.c b/main.c
index 826ff45..cdaf137 100644
--- a/main.c
+++ b/main.c
@@ -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
diff --git a/mkfile b/mkfile
index 812369b..2a1832f 100644
--- a/mkfile
+++ b/mkfile
@@ -22,7 +22,7 @@ HFILES=dat.h fns.h
BIN=/$objtype/bin
PROLOGFILES=\
- stdlib.pl\
+ system.pl\
repl.pl\
loader.pl
diff --git a/module.c b/module.c
index 07786c2..48c2978 100644
--- a/module.c
+++ b/module.c
@@ -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)
{
diff --git a/parser.c b/parser.c
index 773a0a2..04b2b68 100644
--- a/parser.c
+++ b/parser.c
@@ -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:
diff --git a/stdlib.pl b/system.pl
index 19b20d0..9009ff6 100644
--- a/stdlib.pl
+++ b/system.pl
@@ -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