true.

X = X.

X /= X :- !, fail.
X /= Y.

P -> Q :- P, !, Q.

P -> Q | R :- P, !, Q.
P -> Q | R :- !, R.

X | Y :- X.
X | Y :- Y.

P -> Q; R :- P, !, Q.
P -> Q; R :- !, R.

X;Y :- X.
X;Y :- Y.

(X, Y) :- X, Y.

not(X) :- X, !, fail.
not(X).

defop(700, xfx, =.. )!

Compterm =.. Termlist :-
	nonvar(Compterm), !,
	subuniv(Compterm,0,Termlist).
Compterm =.. [F, .. Args] :- 
	length(Args, Arity),
	functor(Compterm, F, Arity),
	subuniv(Compterm, 1, Args).

subuniv(Compterm,Index, [Term, ..Resterms]) :- 
	term(Index, Compterm, Term),!,
	Index1 is Index + 1,
	subuniv(Compterm,Index1,Resterms).
subuniv(Compterm,Index,[]) :-
	functor(Compterm,_, Arity),
	Index is Arity + 1.

op(X, Y, []) :- !.
op(Precedence, Type, [A, ..B]) :- !,
	defop(Precedence, Type, A), 
	op(Precedence, Type, B).
op(Precedence, Type, Op) :- defop(Precedence, Type, Op).

op(700, fx, [trace, untrace])!

trace [] :- !.
trace [X, ..Y] :- !, spy X, trace Y.
trace X :- spy X.

untrace [] :- !.
untrace [X, ..Y] :- !, unspy X, untrace Y.
untrace X :- unspy X.

name(Atom, List) :-
	var(Atom),
	nonvar(List),
	concat(List, Atom).
name(Atom, List) :-
	atom(Atom),
	explode(Atom, List, 1).
name(Number, List) :-
	number(Number),
	concat([Number], Atom),
	explode(Atom, List, 1).

explode(Atom, [A, ..B], N) :-
	char(N, Atom, A),
	!,
	(N1 is N + 1),
	explode(Atom, B, N1).
explode(Atom, [], N) :-
	strlen(Atom, N1),
	N is N1 + 1.

bagof(X, P, _) :-
	asserta(bag(mark)),
	P,
	asserta(bag(X)),
	fail.
bagof(_, _, L) :- collect_bag([], M), !, L = M.

collect_bag(S, L) :-
	getnext(X), !,
	collect_bag([X|S], L).
collect_bag(L, L).

getnext(X) :-
	definition(bag, Defn),
	unlink_clause(Defn),
	head(Defn, bag(X)),
	X /= mark.

subgoal_of(X) :- ancestors([Y, ..Z]), member(X, Z).

member(X, [X, ..Y]).
member(X, [A, ..B]) :- member(X, B).

clause(Head, Body) :-
	functor(Head, Name, Arity),
	definition(Name, Defn),
	find_clause(Head, Defn, Body).

find_clause(Head, Defn, Body) :-
	head(Defn, Head),
	body(Defn, Body).
find_clause(Head, Defn, Body):-
	next_clause(Defn, Defn1),
	find_clause(Head, Defn1, Body).

retract((Head :- Body)) :- !,
	functor(Head, Name, Arity),
	definition(Name, Defn),
	remove_clause(Head, Defn, Body).
retract(Head) :-
	functor(Head, Name, Arity),
	definition(Name, Defn),
	remove_clause(Head, Defn, true).

remove_clause(Head, Defn, Body) :-
	head(Defn, Head),
	body(Defn, Body),
	unlink_clause(Defn).
remove_clause(Head, Defn, Body) :-
	next_clause(Defn, Defn1),
	remove_clause(Head, Defn1, Body).

retractall(X) :- retract((X :- Y)), fail.
retractall(_).

:- op(700, fx, [load, unload, lib, em]).

unload Fname :-
	retract(file(Fname, Proc_list)), !,
	remove_all(Proc_list), !.
unload Fname.

remove_all([]) :- !.
remove_all([A, ..B]) :- free_proc(A), remove_all(B).

load Fname :- unload Fname, consult(Fname).

lib Fname :-
	concat(['PROLOG:lib/', Fname], X),
	load X.

list_lib :- system('dir PROLOG:lib ').

:- op(1100, fx, import).

import A, B :- !,
	import1(A),
	import B.
import A :- import1(A).

import1(A) :- file(A, _), !.
import1(A) :- load A.

em Fname :- unload Fname, ef Fname, !, consult(Fname).

private([]) :- !.
private([A, ..B]) :- remob(A), private(B).

ask([X|Y], A) :- !,
	concat([X|Y], Q),
	prompt(Old, Q),
	ratom(A),
	prompt(_, Old).
ask(Q, A) :-
	prompt(Old, Q),
	ratom(A),
	prompt(_, Old).

op(100, fx, #)!

#X :- buf_ratom(X).
#X :- unratom.

%	help relies on the existence of the 'mc' multicolumn program.
%	If you have a Berkeley system, ls will produce output in
%	multiple columns without the use of mc.
%	You may also wish to change "pg" to "more".

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% AMIGA: We just use the dir command here. If you have ls you might want to
%        to use ls instead of dir (allows more flexibility via c/l options)
%        The default pager is PPMore, if you don't have it get it, it is VERY
%        usefull. Otherwise More should do the job, but it is hardwired to
%        NTSC :-(
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

help :-
	print('Help is available in the following subjects:\n'),
	system('dir PROLOG:help '),
	print('To ask for help type \'help(Subject)\'').
help(S) :-
	concat(['PPMore PROLOG:help/', S], X),
	system(X).

op(1200, xfx, -->)!
op(700, fx, save)!

save S :- stream_type(S) ,!, listing(S).
save F :- ostream(F,S)	 ,!, listing(S).
save F :- open(F, write, S), listing(S), close(S).

tab(N):- nputs(' ', N).
tab(S, N):- nputs(S, ' ', N).

see(S) :- stream_type(S), !, set_input(S).
see(F) :- current_stream(F, read, S), !, set_input(S).
see(F) :- open(F, read, S), set_input(S).

tell(S) :- stream_type(S), !, set_output(S).
tell(F) :- ostream(F, S),  !, set_output(S).
tell(F) :- open(F, write, S), set_output(S).

rename(Oldf, Newf):- current_stream(Oldf, _, S), !,close(S),relink(Oldf,Newf).
rename(Oldf, Newf):- relink(Oldf, Newf).

close(F):- retract(current_stream(F,_,S)), !, do_close(S).
close(S):- do_close(S), retract(current_stream(F, _, S)).

seen :- current_input(S), close(S).
told :- current_output(S),close(S).

seeing(F):-  current_input(S), (current_stream(F,read,S) -> true | F = S).
telling(F):- current_output(S),(ostream(F,S) -> true | F = S).

ostream(F, S):- current_stream(F, write, S).
ostream(F, S):- current_stream(F, append,S).

profile :-
	check_profiling,
	do_profile.

profile(F) :-
	check_profiling,
	file(F, L),
	member(X, L),
	profile1(X),
	fail.
profile(_).

private([subuniv, explode, member, free, do_profile, check_profiling])!
private([find_clause, remove_clause, unlink_clause])!
private([bag, mark, collect_bag, getnext])!
private([remove_all, free_proc, unratom, import1])!
private([buf_ratom, relink, ostream, do_close, stream_type])!