ref: 48da622d4ad0b4acfe9005dd318ac3f20b4e8672
parent: 0f347162b74d945f509955b6c57e506ab800db7b
author: Peter Mikkelsen <[email protected]>
date: Thu Jul 22 17:54:46 EDT 2021
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
--- 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,7 +63,6 @@
BuiltinProto(builtincharcode);
BuiltinProto(builtinchoicestacksize);
BuiltinProto(builtincollectgarbage);
-BuiltinProto(builtinloadmodulefromfile);
BuiltinProto(builtinflushoutput);
BuiltinProto(builtinstreamproperties);
BuiltinProto(builtinsetstreamposition);
@@ -70,6 +69,8 @@
BuiltinProto(builtinop);
BuiltinProto(builtincurrentops);
BuiltinProto(builtinnewemptymodule);
+BuiltinProto(builtindeletemodule);
+BuiltinProto(builtinactivatesystemmodule);
BuiltinProto(builtinhalt);
int compareterms(Term *, Term *);
@@ -186,8 +187,6 @@
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 @@
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 @@
}
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 @@
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;
@@ -1650,6 +1632,26 @@
USED(module);
Rune *name = goal->children->text;
addemptymodule(name);
+ return 1;
+}
+
+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;
}
--- a/dat.h
+++ b/dat.h
@@ -154,7 +154,5 @@
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 */
--- a/eval.c
+++ b/eval.c
@@ -14,7 +14,7 @@
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;
@@ -44,6 +44,15 @@
goto Backtrack;
}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;
--- a/fns.h
+++ b/fns.h
@@ -69,9 +69,10 @@
/* 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 *);
--- 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 @@
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_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 @@
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) :-
--- a/main.c
+++ b/main.c
@@ -11,7 +11,6 @@
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 @@
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
--- a/mkfile
+++ b/mkfile
@@ -22,7 +22,7 @@
BIN=/$objtype/bin
PROLOGFILES=\
- stdlib.pl\
+ system.pl\
repl.pl\
loader.pl
--- a/module.c
+++ b/module.c
@@ -8,56 +8,30 @@
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;
+ return 0;
- /* 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;
- }
-
Predicate *currentpred = nil;
Term *t;
for(t = terms; t != nil; t = t->next){@@ -79,10 +53,7 @@
/* 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 @@
}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 @@
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++){@@ -134,6 +100,24 @@
}
modules = m;
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 *
--- a/parser.c
+++ b/parser.c
@@ -70,7 +70,7 @@
parsein = bio;
nexttoken();
- currentmod = usermodule;
+ currentmod = getmodule(L"user");
Term *result = prologtext(querymode);
if(querymode && result){@@ -101,12 +101,7 @@
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);
@@ -576,20 +571,6 @@
{ print("Syntax error: Unexpected %d (%S) token in %s\n", lookahead.tag, lookahead.text, where); exits("syntax error");-}
-
-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
--- a/prettyprint.c
+++ b/prettyprint.c
@@ -16,7 +16,7 @@
Rune *result;
Rune *args;
if(mod == nil)
- mod = usermodule;
+ mod = getmodule(L"user");
switch(t->tag){case CompoundTerm:
--- a/stdlib.pl
+++ /dev/null
@@ -1,699 +1,0 @@
-:-(module(system, [])).
-
-% Insert the standard operators
-
-:-(op(1200, fx, :-)).
-:- op(1200, fx, ?-).
-:- op(1200, xfx, :-).
-:- op(1200, xfx, -->).
-:- op(1100, xfy, ;).
-:- op(1050, xfy, ->).
-:- op(1000, xfy, ',').
-:- op(900, fy, \+).
-:- op(700, xfx, =).
-:- op(700, xfx, \=).
-:- op(700, xfx, ==).
-:- op(700, xfx, \==).
-:- op(700, xfx, @<).
-:- op(700, xfx, @=<).
-:- op(700, xfx, @>).
-:- op(700, xfx, @>=).
-:- op(700, xfx, =..).
-:- op(700, xfx, is).
-:- op(700, xfx, =:=).
-:- op(700, xfx, =\=).
-:- op(700, xfx, <).
-:- op(700, xfx, =<).
-:- op(700, xfx, >).
-:- op(700, xfx, >=).
-:- op(600, xfy, :).
-:- op(500, yfx, +).
-:- op(500, yfx, -).
-:- op(500, yfx, /\).
-:- op(500, yfx, \/).
-:- op(400, yfx, *).
-:- op(400, yfx, /).
-:- op(400, yfx, //).
-:- op(400, yfx, rem).
-:- op(400, yfx, mod).
-:- op(400, yfx, <<).
-:- op(400, yfx, >>).
-:- op(200, xfx, **).
-:- op(200, xfy, ^).
-:- op(200, fy, -).
-:- op(200, fy, \).
-
-% Logic and control predicates
-\+ Goal :- call(Goal), !, fail.
-\+ Goal.
-
-once(Goal) :-
- call(Goal),
- !.
-
-repeat :- true ; repeat.
-
-% Control structures.
-
-If -> Then :-
- If, !, Then.
-
-If -> Then ; _ :-
- If, !, Then.
-
-_ -> _ ; Else :-
- !, Else.
-
-If ; _ :-
- If.
-
-_ ; Else :-
- Else.
-
-A , B :- A , B.
-
-% Term unification
-A = A.
-
-A \= B :-
- \+ A = B.
-
-% Comparison of terms using the standard order
-
-A == B :-
- compare(=, A, B).
-
-A \== B :-
- \+ A == B.
-
-A @< B :-
- compare(<, A, B).
-
-A @=< B :-
- A == B.
-A @=< B :-
- A @< B.
-
-A @> B :-
- compare(>, A, B).
-
-A @>= B :-
- A == B.
-A @>= B :-
- A @> B.
-
-% Input output
-
-open(SourceSink, Mode, Stream) :-
- open(SourceSink, Mode, Stream, []).
-
-close(StreamOrAlias) :-
- close(StreamOrAlias, []).
-
-flush_output :-
- current_output(S),
- flush_output(S).
-
-stream_property(S, P) :-
- stream_properties(Props),
- member(prop(S,P), Props).
-
-at_end_of_stream :-
- current_input(S),
- stream_property(S, end_of_stream(E)),
- !,
- (E = at ; E = past),
- !.
-
-at_end_of_stream(S_or_a) :-
- ( atom(S_or_a)
- -> stream_property(S, alias(S_or_a))
- ; S = S_or_a
- ),
- stream_property(S, end_of_stream(E)),
- !,
- (E = at; E = past),
- !.
-
-% Standard exceptions
-
-instantiation_error :-
- throw(error(instantiation_error, _)).
-
-type_error(ValidType, Culprit) :-
- throw(error(type_error(ValidType, Culprit), _)).
-
-domain_error(ValidDomain, Culprit) :-
- throw(error(domain_error(ValidDomain, Culprit), _)).
-
-existence_error(ObjectType, Culprit) :-
- throw(error(existence_error(ObjectType, Culprit), _)).
-
-permission_error(Operation, PermissionType, Culprit) :-
- throw(error(permission_error(Operation, PermissionType, Culprit), _)).
-
-representation_error(Flag) :-
- throw(error(representation_error(Flag), _)).
-
-evaluation_error(Error) :-
- throw(error(evaluation_error(Error), _)).
-
-resource_error(Resource) :-
- throw(error(resource_error(Resource), _)).
-
-syntax_error(Error) :-
- throw(error(syntax_error(Error), _)).
-
-% Input and output
-parse_read_option(variables(Vs), options(variables, Vs)).
-parse_read_option(variable_names(VNames), option(variable_names, VNames)).
-parse_read_option(singletons(S), options(singletons, S)).
-
-parse_read_options([], []).
-parse_read_options([Op|Rest], [OpParsed|RestParsed]) :-
- is_nonvar(Op),
- parse_read_options(Rest, RestParsed),
- ( parse_read_option(Op, OpParsed)
- -> true
- ; domain_error(read_option, Op)
- ).
-
-read_term(S, Term, Options) :-
- is_nonvar(Options),
- is_list(Options),
- parse_read_options(Options, ParsedOptions),
- '$read_term'(S, Term, ParsedOptions).
-
-read_term(Term, Options) :-
- current_input(S),
- read_term(S, Term, Options).
-
-read(Term) :-
- current_input(S),
- read_term(S, Term, []).
-
-read(S, Term) :-
- read_term(S, Term, []).
-
-parse_write_option(quoted(true), option(quoted, 1)).
-parse_write_option(quoted(false), option(quoted, 0)).
-parse_write_option(ignore_ops(true), option(ignore_ops, 1)).
-parse_write_option(ignore_ops(false), option(ignore_ops, 0)).
-parse_write_option(numbervars(true), option(numbervars, 1)).
-parse_write_option(numbervars(false), option(numbervars, 0)).
-
-parse_write_options([], []).
-parse_write_options([Op|Rest], [OpParsed|RestParsed]) :-
- is_nonvar(Op),
- parse_write_options(Rest, RestParsed),
- ( parse_write_option(Op, OpParsed)
- -> true
- ; domain_error(write_option, Op)
- ).
-write_term(S, Term, Options) :-
- is_nonvar(Options),
- is_list(Options),
- parse_write_options(Options, ParsedOptions),
- '$write_term'(S, Term, ParsedOptions).
-
-
-write_term(Term, Options) :-
- current_output(S),
- write_term(S, Term, Options).
-
-write(Term) :-
- current_output(S),
- write_term(S, Term, [numbervars(true)]).
-
-write(S, Term) :-
- write_term(S, Term, [numbervars(true)]).
-
-writeq(Term) :-
- current_output(S),
- write_term(S, Term, [quoted(true), numbervars(true)]).
-
-writeq(S, Term) :-
- write_term(S, Term, [quoted(true), numbervars(true)]).
-
-write_canonical(Term) :-
- current_output(S),
- write_term(S, Term, [quoted(true), ignore_ops(true)]).
-
-write_canonical(S, Term) :-
- write_term(S, Term, [quoted(true), ignore_ops(true)]).
-
-% Arithmetic comparisons defined in terms of >=. This is not the most effective way,
-% but it is fine for now.
-
-E1 =:= E2 :-
- E1 >= E2,
- E2 >= E1.
-
-E1 =\= E2 :-
- \+ E1 =:= E2.
-
-E1 < E2 :-
- E2 >= E1,
- E1 =\= E2.
-
-E1 =< E2 :-
- E2 >= E1.
-
-E1 > E2 :-
- E2 < E1.
-
-
-% Clause retrieval and information and removal
-
-clause(Head, Body) :-
- clause(Head, Body, Clauses),
- member(clause(Head, Body), Clauses).
-
-current_predicate(PI) :-
- current_predicate(PI, Predicates),
- member(PI, Predicates).
-
-retract(Clause) :-
- copy_term(Clause, ClauseCopy),
- retract_one(ClauseCopy),
- ( Clause = ClauseCopy
- ; retract(Clause)
- ).
-
-% Basic list predicates
-
-member(X, [X|_]).
-member(X, [_|Tail]) :-
- member(X, Tail).
-
-append([], Ys, Ys).
-append([X|Xs], Ys, [X|Zs]) :-
- append(Xs, Ys, Zs).
-
-length([], 0).
-length([_|T], Len) :-
- length(T, Len0),
- Len is Len0 + 1.
-
-unique([], []).
-unique([H|T], [H|Rest]) :-
- findall(_, (member(X, T), X == H), []),
- !,
- unique(T, Rest).
-unique([H|T], Rest) :-
- unique(T, Rest).
-
-union(A, B, C) :-
- append(A, B, C0),
- unique(C0, C).
-
-difference(A, B, Diff) :-
- append(A, B, AB),
- unique_in(AB, AB, Diff).
-
-unique_in([], _, []).
-unique_in([H|T], L, [H|Rest]) :-
- findall(_, (member(X, L), X == H), [_]),
- !,
- unique_in(T, L, Rest).
-unique_in([H|T], L, Rest) :-
- unique_in(T, L, Rest).
-
-include(_, [], []).
-include(Goal, [X|Xs], Included) :-
- Goal =.. L,
- append(L, [X], L1),
- G =.. L1,
- ( call(G)
- -> Included = [X|Included0]
- ; Included = Included0
- ),
- include(Goal, Xs, Included0).
-
-% Additional type tests
-
-callable(T) :- atom(T) ; compound(T).
-
-list([]).
-list([_|T]) :- list(T).
-
-partial_list(T) :- var(T).
-partial_list([_|T]) :- partial_list(T).
-
-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_or_var(T) :- (atom(T) ; var(T)), ! ; type_error(atom, T).
-
-is_callable(T) :- callable(T), ! ; type_error(callable, T).
-
-is_nonvar(T) :- nonvar(T), ! ; instantiation_error.
-
-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_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).
-
-% All solutions
-
-findall(Template, Goal, Instances) :-
- is_nonvar(Goal),
- is_callable(Goal),
- is_list_or_partial_list(Instances),
- system:asserta('find all'([])),- call(Goal),
- system:asserta('find all'(solution(Template))),- fail.
-findall(Template, Goal, Instances) :-
- findall_collect([], Instances).
-
-findall_collect(Acc, Instances) :-
- system:retract('find all'(Item)),- !,
- findall_collect(Item, Acc, Instances).
-findall_collect([], Instances, Instances).
-findall_collect(solution(T), Acc, Instances) :-
- findall_collect([T|Acc], Instances).
-
-bagof(Template, Goal, Instances) :-
- free_variable_set(Goal, Template, Witness),
- iterated_goal(Goal, G),
- findall(Witness+Template, G, S),
- bagof_loop(Witness, S, Instances).
-
-bagof_loop(Witness, S, Instances) :-
- [W+T|_] = S,
- bagof_wt_list(S, W+T, WT_list),
- bagof_split(WT_list, W_list, T_list),
- ( bagof_unify_list(Witness, W_list), Instances = T_list
- ; bagof_next_s(S, WT_list, S_next), bagof_loop(Witness, S_next, Instances)
- ).
-
-bagof_wt_list([], _, []).
-bagof_wt_list([W+T|Tail], W0+T0, Rest) :-
- copy_term(W+T, W1+T1),
- bagof_wt_list(Tail, W0+T0, Rest0),
- ( variant(W1, W0)
- -> Rest = [W1+T1|Rest0]
- ; Rest = Rest0
- ).
-
-copy_terms_list([], []).
-copy_terms_list([H|T], [HH|TT]) :-
- copy_term(H, HH),
- copy_terms_list(T, TT).
-bagof_split([], [], []).
-bagof_split([WW+TT|RestWT], [WW|RestW], [TT|RestT]) :-
- bagof_split(RestWT, RestW, RestT).
-
-bagof_unify_list(W, []).
-bagof_unify_list(W, [W|T]) :- bagof_unify_list(W, T).
-
-bagof_next_s([], _, []).
-bagof_next_s([H|T], WT_list, Rest) :-
- bagof_next_s(T, WT_list, Rest0),
- ( findall(_, (member(X, WT_list), variant(X, H)), [])
- -> Rest = [H|Rest0]
- ; Rest = Rest0
- ).
-
-setof(Template, Goal, Instances) :-
- bagof(Template, Goal, Instances_list),
- sort(Instances_list, Instances).
-
-% misc helpers
-
-variable_set(Term, []) :-
- atomic(Term).
-variable_set(Term, [Term]) :-
- var(Term).
-variable_set(Term, Vars) :-
- compound(Term),
- Term =.. [_|Args],
- variable_set(Args, [], Vars0),
- unique(Vars0, Vars).
-
-variable_set([], Acc, Acc).
-variable_set([Arg|Rest], Acc0, Result) :-
- variable_set(Arg, VarSet),
- append(Acc0, VarSet, Acc),
- variable_set(Rest, Acc, Result).
-
-existential_variable_set(Term, []) :-
- (atomic(Term) ; var(Term)),
- !.
-existential_variable_set(V^G, Vars) :-
- !,
- existential_variable_set(G, Vars0),
- variable_set(V, Vars1),
- union(Vars0, Vars1, Vars).
-existential_variable_set(_, []).
-
-free_variable_set(T, V, Vars) :-
- variable_set(T, TVars),
- variable_set(V, VVars),
- existential_variable_set(T, TExVars),
- union(VVars, TExVars, BV),
- difference(TVars, BV, Vars).
-
-iterated_goal(Goal, T) :-
- compound(Goal),
- _^G = Goal,
- !,
- iterated_goal(G, T).
-iterated_goal(G, G).
-
-variant(T1, T2) :-
- var(T1), var(T2), !.
-variant(T1, T2) :-
- compound(T1),
- compound(T2),
- !,
- T1 =.. [Name|Args1],
- T2 =.. [Name|Args2],
- variant_list(Args1, Args2).
-variant(T1, T2) :-
- T1 == T2.
-
-variant_list([], []).
-variant_list([H1|T1], [H2|T2]) :-
- variant(H1, H2),
- variant_list(T1, T2).
-
-% Sorting, which also removes duplicates (should be implemented in C for speed I think).
-
-sort(Ls0, Ls) :-
- append(Lefts, [A,B|Rights], Ls0),
- A @> B,
- !,
- append(Lefts, [B,A|Rights], Ls1),
- sort(Ls1, Ls).
-sort(Ls0, Ls) :-
- append(Lefts, [A,B|Rights], Ls0),
- A == B,
- !,
- append(Lefts, [A|Rights], Ls1),
- sort(Ls1, Ls).
-sort(Ls, Ls).
-
-% Atomic term processing
-
-atom_concat(A1, A2, A3) :-
- is_atom_or_var(A1),
- is_atom_or_var(A2),
- is_atom_or_var(A3),
- atom(A1), atom(A2),
- !,
- atom_codes(A1, Codes1),
- atom_codes(A2, Codes2),
- append(Codes1, Codes2, Codes),
- atom_codes(A3, Codes).
-atom_concat(A1, A2, A3) :-
- is_atom_or_var(A1),
- is_atom_or_var(A2),
- is_atom_or_var(A3),
- atom(A3),
- !,
- atom_codes(A3, Codes),
- append(Codes1, Codes2, Codes),
- atom_codes(A1, Codes1),
- atom_codes(A2, Codes2).
-atom_concat(A1, A2, A3) :-
- instantiation_error.
-
-% Character input/output
-
-get_char(Char) :-
- current_input(S),
- get_char(S, Char).
-
-get_code(Code) :-
- current_input(S),
- get_code(S, Code).
-
-get_code(S, Code) :-
- get_char(S, Char),
- ( Char = end_of_file
- -> Code = -1
- ; char_code(Char, Code)
- ).
-
-peek_char(Char) :-
- current_input(S),
- peek_char(S, Char).
-
-peek_code(Code) :-
- current_input(S),
- peek_code(S, Code).
-
-peek_code(S, Code) :-
- peek_char(S, Char),
- ( Char = end_of_file
- -> Code = -1
- ; char_code(Char, Code)
- ).
-
-put_char(Char) :-
- current_output(S),
- put_char(S, Char).
-
-put_code(Code) :-
- current_output(S),
- put_code(S, Code).
-
-put_code(S, Code) :-
- char_code(Char, Code),
- put_char(S, Char).
-
-nl :-
- current_output(S),
- nl(S).
-
-nl(S) :-
- put_char(S, '
-'). % This should really be \n
-
-% flags
-set_prolog_flag(Flag, Value) :-
- is_nonvar(Flag),
- is_nonvar(Value),
- is_atom(Flag),
- is_prolog_flag(Flag),
- is_appropriate_flag_value(Flag, Value),
- is_modifiable_flag(Flag),
- '$set_prolog_flag'(Flag, Value).
-
-current_prolog_flag(Flag, Value) :-
- is_atom_or_var(Flag),
- ( atom(Flag)
- -> is_prolog_flag(Flag)
- ; true
- ),
- current_prolog_flags(FlagsAndValues),
- member(flag(Flag, Value), FlagsAndValues).
-
-is_prolog_flag(Flag) :-
- member(Flag,
- [ bounded
- , max_integer
- , min_integer
- , integer_rounding_function
- , char_conversion
- , debug
- , max_arity
- , unknown
- , double_quotes]),
- !
- ; domain_error(prolog_flag, Flag).
-
-is_modifiable_flag(Flag) :-
- member(Flag, [char_conversion, debug, unknown, double_quotes]),
- !
- ; permission_error(modify, flag, Flag).
-
-is_appropriate_flag_value(Flag, Value) :-
- appropriate_flag_values(Flag, Values),
- member(Value, Values),
- !
- ; domain_error(flag_value, Flag + Value).
-
-appropriate_flag_values(bounded, [true, false]).
-appropriate_flag_values(max_integer, [Val]) :-
- current_prolog_flag(max_integer, Val).
-appropriate_flag_values(min_integer, [Val]) :-
- current_prolog_flag(min_integer, Val).
-appropriate_flag_values(integer_rounding_function, [down, toward_zero]).
-appropriate_flag_values(char_conversion, [on, off]).
-appropriate_flag_values(debug, [on, off]).
-appropriate_flag_values(max_arity, [Val]) :-
- current_prolog_flag(max_arity).
-appropriate_flag_values(unknown, [error, fail, warning]).
-appropriate_flag_values(double_quotes, [chars, codes, atom]).
-
-% Operator table modification and inspection
-
-op(Priority, Op_specifier, Operator) :-
- is_nonvar(Priority),
- is_integer(Priority),
- is_nonvar(Op_specifier),
- is_atom(Op_specifier),
- ( operator_priority(Priority), !
- ; domain_error(operator_priority, Priority)
- ),
- ( operator_specifier(Op_specifier), !
- ; domain_error(operator_specifier, Op_specifier)
- ),
- is_nonvar(Operator),
- ( atom(Operator)
- -> Ops = [Operator]
- ; Ops = Operator
- ),
- is_list(Ops),
- op_helper(Priority, Op_specifier, Ops).
-
-op_helper(Priority, Op_specifier, []).
-op_helper(Priority, Op_specifier, [Op|Ops]) :-
- is_nonvar(Op),
- is_atom(Op),
- '$op'(Priority, Op_specifier, Op),
- op_helper(Priority, Op_specifier, Ops).
-
-operator_priority(P) :-
- integer(P),
- P >= 0,
- P =< 1200.
-
-operator_specifier(S) :-
- member(S, [xf, yf, xfx, xfy, yfx, fx, fy]).
-
-current_op(Priority, Op_specifier, Operator) :-
- ( (var(Priority) ; operator_priority(Priority)), !
- ; domain_error(operator_priority, Priority)
- ),
- ( (var(Op_specifier) ; operator_specifier(Op_specifier)), !
- ; domain_error(operator_specifier, Op_specifier)
- ),
- is_atom_or_var(Operator),
- current_ops(Operators),
- member(op(Priority, Op_specifier, Operator), Operators).
-
-% Halting
-
-halt(X) :-
- is_nonvar(X),
- is_integer(X),
- '$halt'(X).
-
-halt :-
- halt(0).
-
-% Loading prolog text
-
-consult(File) :-
- loader:load_module_from_file(File).
--- /dev/null
+++ b/system.pl
@@ -1,0 +1,699 @@
+:-(module(system, [])).
+
+% Insert the standard operators
+
+:-(op(1200, fx, :-)).
+:- op(1200, fx, ?-).
+:- op(1200, xfx, :-).
+:- op(1200, xfx, -->).
+:- op(1100, xfy, ;).
+:- op(1050, xfy, ->).
+:- op(1000, xfy, ',').
+:- op(900, fy, \+).
+:- op(700, xfx, =).
+:- op(700, xfx, \=).
+:- op(700, xfx, ==).
+:- op(700, xfx, \==).
+:- op(700, xfx, @<).
+:- op(700, xfx, @=<).
+:- op(700, xfx, @>).
+:- op(700, xfx, @>=).
+:- op(700, xfx, =..).
+:- op(700, xfx, is).
+:- op(700, xfx, =:=).
+:- op(700, xfx, =\=).
+:- op(700, xfx, <).
+:- op(700, xfx, =<).
+:- op(700, xfx, >).
+:- op(700, xfx, >=).
+:- op(600, xfy, :).
+:- op(500, yfx, +).
+:- op(500, yfx, -).
+:- op(500, yfx, /\).
+:- op(500, yfx, \/).
+:- op(400, yfx, *).
+:- op(400, yfx, /).
+:- op(400, yfx, //).
+:- op(400, yfx, rem).
+:- op(400, yfx, mod).
+:- op(400, yfx, <<).
+:- op(400, yfx, >>).
+:- op(200, xfx, **).
+:- op(200, xfy, ^).
+:- op(200, fy, -).
+:- op(200, fy, \).
+
+% Logic and control predicates
+\+ Goal :- call(Goal), !, fail.
+\+ Goal.
+
+once(Goal) :-
+ call(Goal),
+ !.
+
+repeat :- true ; repeat.
+
+% Control structures.
+
+If -> Then :-
+ If, !, Then.
+
+If -> Then ; _ :-
+ If, !, Then.
+
+_ -> _ ; Else :-
+ !, Else.
+
+If ; _ :-
+ If.
+
+_ ; Else :-
+ Else.
+
+A , B :- A , B.
+
+% Term unification
+A = A.
+
+A \= B :-
+ \+ A = B.
+
+% Comparison of terms using the standard order
+
+A == B :-
+ compare(=, A, B).
+
+A \== B :-
+ \+ A == B.
+
+A @< B :-
+ compare(<, A, B).
+
+A @=< B :-
+ A == B.
+A @=< B :-
+ A @< B.
+
+A @> B :-
+ compare(>, A, B).
+
+A @>= B :-
+ A == B.
+A @>= B :-
+ A @> B.
+
+% Input output
+
+open(SourceSink, Mode, Stream) :-
+ open(SourceSink, Mode, Stream, []).
+
+close(StreamOrAlias) :-
+ close(StreamOrAlias, []).
+
+flush_output :-
+ current_output(S),
+ flush_output(S).
+
+stream_property(S, P) :-
+ stream_properties(Props),
+ member(prop(S,P), Props).
+
+at_end_of_stream :-
+ current_input(S),
+ stream_property(S, end_of_stream(E)),
+ !,
+ (E = at ; E = past),
+ !.
+
+at_end_of_stream(S_or_a) :-
+ ( atom(S_or_a)
+ -> stream_property(S, alias(S_or_a))
+ ; S = S_or_a
+ ),
+ stream_property(S, end_of_stream(E)),
+ !,
+ (E = at; E = past),
+ !.
+
+% Standard exceptions
+
+instantiation_error :-
+ throw(error(instantiation_error, _)).
+
+type_error(ValidType, Culprit) :-
+ throw(error(type_error(ValidType, Culprit), _)).
+
+domain_error(ValidDomain, Culprit) :-
+ throw(error(domain_error(ValidDomain, Culprit), _)).
+
+existence_error(ObjectType, Culprit) :-
+ throw(error(existence_error(ObjectType, Culprit), _)).
+
+permission_error(Operation, PermissionType, Culprit) :-
+ throw(error(permission_error(Operation, PermissionType, Culprit), _)).
+
+representation_error(Flag) :-
+ throw(error(representation_error(Flag), _)).
+
+evaluation_error(Error) :-
+ throw(error(evaluation_error(Error), _)).
+
+resource_error(Resource) :-
+ throw(error(resource_error(Resource), _)).
+
+syntax_error(Error) :-
+ throw(error(syntax_error(Error), _)).
+
+% Input and output
+parse_read_option(variables(Vs), options(variables, Vs)).
+parse_read_option(variable_names(VNames), option(variable_names, VNames)).
+parse_read_option(singletons(S), options(singletons, S)).
+
+parse_read_options([], []).
+parse_read_options([Op|Rest], [OpParsed|RestParsed]) :-
+ is_nonvar(Op),
+ parse_read_options(Rest, RestParsed),
+ ( parse_read_option(Op, OpParsed)
+ -> true
+ ; domain_error(read_option, Op)
+ ).
+
+read_term(S, Term, Options) :-
+ is_nonvar(Options),
+ is_list(Options),
+ parse_read_options(Options, ParsedOptions),
+ '$read_term'(S, Term, ParsedOptions).
+
+read_term(Term, Options) :-
+ current_input(S),
+ read_term(S, Term, Options).
+
+read(Term) :-
+ current_input(S),
+ read_term(S, Term, []).
+
+read(S, Term) :-
+ read_term(S, Term, []).
+
+parse_write_option(quoted(true), option(quoted, 1)).
+parse_write_option(quoted(false), option(quoted, 0)).
+parse_write_option(ignore_ops(true), option(ignore_ops, 1)).
+parse_write_option(ignore_ops(false), option(ignore_ops, 0)).
+parse_write_option(numbervars(true), option(numbervars, 1)).
+parse_write_option(numbervars(false), option(numbervars, 0)).
+
+parse_write_options([], []).
+parse_write_options([Op|Rest], [OpParsed|RestParsed]) :-
+ is_nonvar(Op),
+ parse_write_options(Rest, RestParsed),
+ ( parse_write_option(Op, OpParsed)
+ -> true
+ ; domain_error(write_option, Op)
+ ).
+write_term(S, Term, Options) :-
+ is_nonvar(Options),
+ is_list(Options),
+ parse_write_options(Options, ParsedOptions),
+ '$write_term'(S, Term, ParsedOptions).
+
+
+write_term(Term, Options) :-
+ current_output(S),
+ write_term(S, Term, Options).
+
+write(Term) :-
+ current_output(S),
+ write_term(S, Term, [numbervars(true)]).
+
+write(S, Term) :-
+ write_term(S, Term, [numbervars(true)]).
+
+writeq(Term) :-
+ current_output(S),
+ write_term(S, Term, [quoted(true), numbervars(true)]).
+
+writeq(S, Term) :-
+ write_term(S, Term, [quoted(true), numbervars(true)]).
+
+write_canonical(Term) :-
+ current_output(S),
+ write_term(S, Term, [quoted(true), ignore_ops(true)]).
+
+write_canonical(S, Term) :-
+ write_term(S, Term, [quoted(true), ignore_ops(true)]).
+
+% Arithmetic comparisons defined in terms of >=. This is not the most effective way,
+% but it is fine for now.
+
+E1 =:= E2 :-
+ E1 >= E2,
+ E2 >= E1.
+
+E1 =\= E2 :-
+ \+ E1 =:= E2.
+
+E1 < E2 :-
+ E2 >= E1,
+ E1 =\= E2.
+
+E1 =< E2 :-
+ E2 >= E1.
+
+E1 > E2 :-
+ E2 < E1.
+
+
+% Clause retrieval and information and removal
+
+clause(Head, Body) :-
+ clause(Head, Body, Clauses),
+ member(clause(Head, Body), Clauses).
+
+current_predicate(PI) :-
+ current_predicate(PI, Predicates),
+ member(PI, Predicates).
+
+retract(Clause) :-
+ copy_term(Clause, ClauseCopy),
+ retract_one(ClauseCopy),
+ ( Clause = ClauseCopy
+ ; retract(Clause)
+ ).
+
+% Basic list predicates
+
+member(X, [X|_]).
+member(X, [_|Tail]) :-
+ member(X, Tail).
+
+append([], Ys, Ys).
+append([X|Xs], Ys, [X|Zs]) :-
+ append(Xs, Ys, Zs).
+
+length([], 0).
+length([_|T], Len) :-
+ length(T, Len0),
+ Len is Len0 + 1.
+
+unique([], []).
+unique([H|T], [H|Rest]) :-
+ findall(_, (member(X, T), X == H), []),
+ !,
+ unique(T, Rest).
+unique([H|T], Rest) :-
+ unique(T, Rest).
+
+union(A, B, C) :-
+ append(A, B, C0),
+ unique(C0, C).
+
+difference(A, B, Diff) :-
+ append(A, B, AB),
+ unique_in(AB, AB, Diff).
+
+unique_in([], _, []).
+unique_in([H|T], L, [H|Rest]) :-
+ findall(_, (member(X, L), X == H), [_]),
+ !,
+ unique_in(T, L, Rest).
+unique_in([H|T], L, Rest) :-
+ unique_in(T, L, Rest).
+
+include(_, [], []).
+include(Goal, [X|Xs], Included) :-
+ Goal =.. L,
+ append(L, [X], L1),
+ G =.. L1,
+ ( call(G)
+ -> Included = [X|Included0]
+ ; Included = Included0
+ ),
+ include(Goal, Xs, Included0).
+
+% Additional type tests
+
+callable(T) :- atom(T) ; compound(T).
+
+list([]).
+list([_|T]) :- list(T).
+
+partial_list(T) :- var(T).
+partial_list([_|T]) :- partial_list(T).
+
+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_or_var(T) :- (atom(T) ; var(T) ; type_error(atom, T)), !.
+
+is_callable(T) :- (callable(T) ; type_error(callable, T)), !.
+
+is_nonvar(T) :- (nonvar(T) ; instantiation_error), !.
+
+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_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)), !.
+
+% All solutions
+
+findall(Template, Goal, Instances) :-
+ is_nonvar(Goal),
+ is_callable(Goal),
+ is_list_or_partial_list(Instances),
+ system:asserta('find all'([])),+ call(Goal),
+ system:asserta('find all'(solution(Template))),+ fail.
+findall(Template, Goal, Instances) :-
+ findall_collect([], Instances).
+
+findall_collect(Acc, Instances) :-
+ system:retract('find all'(Item)),+ !,
+ findall_collect(Item, Acc, Instances).
+findall_collect([], Instances, Instances).
+findall_collect(solution(T), Acc, Instances) :-
+ findall_collect([T|Acc], Instances).
+
+bagof(Template, Goal, Instances) :-
+ free_variable_set(Goal, Template, Witness),
+ iterated_goal(Goal, G),
+ findall(Witness+Template, G, S),
+ bagof_loop(Witness, S, Instances).
+
+bagof_loop(Witness, S, Instances) :-
+ [W+T|_] = S,
+ bagof_wt_list(S, W+T, WT_list),
+ bagof_split(WT_list, W_list, T_list),
+ ( bagof_unify_list(Witness, W_list), Instances = T_list
+ ; bagof_next_s(S, WT_list, S_next), bagof_loop(Witness, S_next, Instances)
+ ).
+
+bagof_wt_list([], _, []).
+bagof_wt_list([W+T|Tail], W0+T0, Rest) :-
+ copy_term(W+T, W1+T1),
+ bagof_wt_list(Tail, W0+T0, Rest0),
+ ( variant(W1, W0)
+ -> Rest = [W1+T1|Rest0]
+ ; Rest = Rest0
+ ).
+
+copy_terms_list([], []).
+copy_terms_list([H|T], [HH|TT]) :-
+ copy_term(H, HH),
+ copy_terms_list(T, TT).
+bagof_split([], [], []).
+bagof_split([WW+TT|RestWT], [WW|RestW], [TT|RestT]) :-
+ bagof_split(RestWT, RestW, RestT).
+
+bagof_unify_list(W, []).
+bagof_unify_list(W, [W|T]) :- bagof_unify_list(W, T).
+
+bagof_next_s([], _, []).
+bagof_next_s([H|T], WT_list, Rest) :-
+ bagof_next_s(T, WT_list, Rest0),
+ ( findall(_, (member(X, WT_list), variant(X, H)), [])
+ -> Rest = [H|Rest0]
+ ; Rest = Rest0
+ ).
+
+setof(Template, Goal, Instances) :-
+ bagof(Template, Goal, Instances_list),
+ sort(Instances_list, Instances).
+
+% misc helpers
+
+variable_set(Term, []) :-
+ atomic(Term).
+variable_set(Term, [Term]) :-
+ var(Term).
+variable_set(Term, Vars) :-
+ compound(Term),
+ Term =.. [_|Args],
+ variable_set(Args, [], Vars0),
+ unique(Vars0, Vars).
+
+variable_set([], Acc, Acc).
+variable_set([Arg|Rest], Acc0, Result) :-
+ variable_set(Arg, VarSet),
+ append(Acc0, VarSet, Acc),
+ variable_set(Rest, Acc, Result).
+
+existential_variable_set(Term, []) :-
+ (atomic(Term) ; var(Term)),
+ !.
+existential_variable_set(V^G, Vars) :-
+ !,
+ existential_variable_set(G, Vars0),
+ variable_set(V, Vars1),
+ union(Vars0, Vars1, Vars).
+existential_variable_set(_, []).
+
+free_variable_set(T, V, Vars) :-
+ variable_set(T, TVars),
+ variable_set(V, VVars),
+ existential_variable_set(T, TExVars),
+ union(VVars, TExVars, BV),
+ difference(TVars, BV, Vars).
+
+iterated_goal(Goal, T) :-
+ compound(Goal),
+ _^G = Goal,
+ !,
+ iterated_goal(G, T).
+iterated_goal(G, G).
+
+variant(T1, T2) :-
+ var(T1), var(T2), !.
+variant(T1, T2) :-
+ compound(T1),
+ compound(T2),
+ !,
+ T1 =.. [Name|Args1],
+ T2 =.. [Name|Args2],
+ variant_list(Args1, Args2).
+variant(T1, T2) :-
+ T1 == T2.
+
+variant_list([], []).
+variant_list([H1|T1], [H2|T2]) :-
+ variant(H1, H2),
+ variant_list(T1, T2).
+
+% Sorting, which also removes duplicates (should be implemented in C for speed I think).
+
+sort(Ls0, Ls) :-
+ append(Lefts, [A,B|Rights], Ls0),
+ A @> B,
+ !,
+ append(Lefts, [B,A|Rights], Ls1),
+ sort(Ls1, Ls).
+sort(Ls0, Ls) :-
+ append(Lefts, [A,B|Rights], Ls0),
+ A == B,
+ !,
+ append(Lefts, [A|Rights], Ls1),
+ sort(Ls1, Ls).
+sort(Ls, Ls).
+
+% Atomic term processing
+
+atom_concat(A1, A2, A3) :-
+ is_atom_or_var(A1),
+ is_atom_or_var(A2),
+ is_atom_or_var(A3),
+ atom(A1), atom(A2),
+ !,
+ atom_codes(A1, Codes1),
+ atom_codes(A2, Codes2),
+ append(Codes1, Codes2, Codes),
+ atom_codes(A3, Codes).
+atom_concat(A1, A2, A3) :-
+ is_atom_or_var(A1),
+ is_atom_or_var(A2),
+ is_atom_or_var(A3),
+ atom(A3),
+ !,
+ atom_codes(A3, Codes),
+ append(Codes1, Codes2, Codes),
+ atom_codes(A1, Codes1),
+ atom_codes(A2, Codes2).
+atom_concat(A1, A2, A3) :-
+ instantiation_error.
+
+% Character input/output
+
+get_char(Char) :-
+ current_input(S),
+ get_char(S, Char).
+
+get_code(Code) :-
+ current_input(S),
+ get_code(S, Code).
+
+get_code(S, Code) :-
+ get_char(S, Char),
+ ( Char = end_of_file
+ -> Code = -1
+ ; char_code(Char, Code)
+ ).
+
+peek_char(Char) :-
+ current_input(S),
+ peek_char(S, Char).
+
+peek_code(Code) :-
+ current_input(S),
+ peek_code(S, Code).
+
+peek_code(S, Code) :-
+ peek_char(S, Char),
+ ( Char = end_of_file
+ -> Code = -1
+ ; char_code(Char, Code)
+ ).
+
+put_char(Char) :-
+ current_output(S),
+ put_char(S, Char).
+
+put_code(Code) :-
+ current_output(S),
+ put_code(S, Code).
+
+put_code(S, Code) :-
+ char_code(Char, Code),
+ put_char(S, Char).
+
+nl :-
+ current_output(S),
+ nl(S).
+
+nl(S) :-
+ put_char(S, '
+'). % This should really be \n
+
+% flags
+set_prolog_flag(Flag, Value) :-
+ is_nonvar(Flag),
+ is_nonvar(Value),
+ is_atom(Flag),
+ is_prolog_flag(Flag),
+ is_appropriate_flag_value(Flag, Value),
+ is_modifiable_flag(Flag),
+ '$set_prolog_flag'(Flag, Value).
+
+current_prolog_flag(Flag, Value) :-
+ is_atom_or_var(Flag),
+ ( atom(Flag)
+ -> is_prolog_flag(Flag)
+ ; true
+ ),
+ current_prolog_flags(FlagsAndValues),
+ member(flag(Flag, Value), FlagsAndValues).
+
+is_prolog_flag(Flag) :-
+ member(Flag,
+ [ bounded
+ , max_integer
+ , min_integer
+ , integer_rounding_function
+ , char_conversion
+ , debug
+ , max_arity
+ , unknown
+ , double_quotes]),
+ !
+ ; domain_error(prolog_flag, Flag).
+
+is_modifiable_flag(Flag) :-
+ member(Flag, [char_conversion, debug, unknown, double_quotes]),
+ !
+ ; permission_error(modify, flag, Flag).
+
+is_appropriate_flag_value(Flag, Value) :-
+ appropriate_flag_values(Flag, Values),
+ member(Value, Values),
+ !
+ ; domain_error(flag_value, Flag + Value).
+
+appropriate_flag_values(bounded, [true, false]).
+appropriate_flag_values(max_integer, [Val]) :-
+ current_prolog_flag(max_integer, Val).
+appropriate_flag_values(min_integer, [Val]) :-
+ current_prolog_flag(min_integer, Val).
+appropriate_flag_values(integer_rounding_function, [down, toward_zero]).
+appropriate_flag_values(char_conversion, [on, off]).
+appropriate_flag_values(debug, [on, off]).
+appropriate_flag_values(max_arity, [Val]) :-
+ current_prolog_flag(max_arity).
+appropriate_flag_values(unknown, [error, fail, warning]).
+appropriate_flag_values(double_quotes, [chars, codes, atom]).
+
+% Operator table modification and inspection
+
+op(Priority, Op_specifier, Operator) :-
+ is_nonvar(Priority),
+ is_integer(Priority),
+ is_nonvar(Op_specifier),
+ is_atom(Op_specifier),
+ ( operator_priority(Priority), !
+ ; domain_error(operator_priority, Priority)
+ ),
+ ( operator_specifier(Op_specifier), !
+ ; domain_error(operator_specifier, Op_specifier)
+ ),
+ is_nonvar(Operator),
+ ( atom(Operator)
+ -> Ops = [Operator]
+ ; Ops = Operator
+ ),
+ is_list(Ops),
+ op_helper(Priority, Op_specifier, Ops).
+
+op_helper(Priority, Op_specifier, []).
+op_helper(Priority, Op_specifier, [Op|Ops]) :-
+ is_nonvar(Op),
+ is_atom(Op),
+ '$op'(Priority, Op_specifier, Op),
+ op_helper(Priority, Op_specifier, Ops).
+
+operator_priority(P) :-
+ integer(P),
+ P >= 0,
+ P =< 1200.
+
+operator_specifier(S) :-
+ member(S, [xf, yf, xfx, xfy, yfx, fx, fy]).
+
+current_op(Priority, Op_specifier, Operator) :-
+ ( (var(Priority) ; operator_priority(Priority)), !
+ ; domain_error(operator_priority, Priority)
+ ),
+ ( (var(Op_specifier) ; operator_specifier(Op_specifier)), !
+ ; domain_error(operator_specifier, Op_specifier)
+ ),
+ is_atom_or_var(Operator),
+ current_ops(Operators),
+ member(op(Priority, Op_specifier, Operator), Operators).
+
+% Halting
+
+halt(X) :-
+ is_nonvar(X),
+ is_integer(X),
+ '$halt'(X).
+
+halt :-
+ halt(0).
+
+% Loading prolog text
+
+consult(File) :-
+ loader:load_module_from_file(File).