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

1 files changed, 699 insertions, 0 deletions

diff --git a/system.pl b/system.pl
new file mode 100644
index 0000000..9009ff6
--- /dev/null
+++ b/system.pl
@@ -0,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).