/*

 *		X PROLOG  Vers. 2.0

 *

 *

 *	Written by : 	Andreas Toenne

 *			CS Dept. , IRB

 *			University of Dortmund, W-Germany

 *			<atoenne@unido.uucp>

 *			<....!seismo!unido!atoenne>

 *			<atoenne@unido.bitnet>

 *

 *	Copyright :	This software is copyrighted by Andreas Toenne.

 *			Permission is granted hereby to copy the entire

 *			package including this copyright notice without fee.

 *

 */

 

%	X Prolog Boot File



% hack to create an intermediate goal for call

% this make the cut local to call



call(A) :- $call(A).



% definitions for conjunction and disjunction

% both procedures are made transparent to the cut



(A ; B) :- $call(A).

(A ; B) :- $call(B).



(A , B) :- $call(A), $call(B).



% further predicates



not(Predicate) :- call(Predicate), !, fail.

not(Predicate).



clause(Head, Body) :- $clause(Head, Body, Help).  % see the documentation



A = A.					% equality predicate :-)



print(Term) :- var(Term), !, write(Term).

print(Term) :- portray(Term).		% portray should be user defined



append([],L,L).				% common append procedure

append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).



member(X, [X|_]).			% common member procedure

member(X, [_|Y]) :- member(X, Y).



% toplevel interpreter loop

% the main goal should not be changed



main :- $loop(toplevel).		% start things

main.					% just to make Xprolog happy



% this is a failure driven loop



$loop(toplevel) :-

	prompt(Old, '|    '),		% change the default prompt

	repeat,				% loop forever

		$prompt('?- '),		% give a prompt

		read(Term),		% wait for response

		$solve(Term, toplevel),	% solve the query

	prompt(_, Old),			% restore the prompt

	!.

$loop(Where) :-				% loop not at top level

	prompt(Old, '| '),		% different default prompt

	repeat,				% round and round again

		prompt_if_user,		% no prompt for files

		read(Term),		% read something

		$solve(Term, Where),	% solve it

	prompt(_, Old),			% restore the prompt

	!.

	

prompt_if_user :- seeing(user), $prompt('| '), !.

prompt_if_user.



$solve(end_of_file, _) :- !.		% the only way to stop the repeat

$solve(Term, _) :- var(Term), !, fail.	% don't accept strange goals

$solve(Term, Where) :-			% try to solve it as a goal

	$query(Term, Where, Goal, What), % check for sort of question

	!,

	prompt(Old, '|: '),

	$solve_goal(Goal, What),	% try to solve a goal

	prompt(_, Old),

	fail.

$solve(Term, Where) :-			% try to assert it

	$process(Term, Result),		% hook for preprocessors

	assertz(Result),		% assert it

	!,

	fail.

$solve(Term, _) :-			% assert or $process failed

	write('! clause: '),

	write(Term),

	fail.

	

% this is a hook to add preprocessors like the grammar rule translator

% to this top level interpreter.

% simply add via 'asserta' another clause for the preprocessor



$process(T,T).



% check the current term for a question or a command



$query(:-(X), _, X, command) :- !.	% this is a command

$query(?-(X), _, X, question) :- !.	% this is a question

$query(X, toplevel, X, question).	% always questions on top level



% this procedure solves goals

% note the use of $more and $goalvars



$solve_goal(Term, command) :-		% no answer, no alternatives

	call(Term),			% try it once

	!.				% and no further alternatives

$solve_goal(_, command)	:-		% above clause failed

	!,

	nl, write('?'), nl.		% notify the user

$solve_goal(Term, question) :-

	$goalvars(List),		% save the reader's symbol table

	call(Term),			% try the question

	$more(Ok),			% call(Term) had a alternative ?

	$reply(List, Ok),		% say 'yes' to the user

	nl,

	!.

$solve_goal(_, question) :-		% above clause failed !

	nl,

	write(no),			% sorry but ...

	nl,

	!.

	

$reply(List, Ok) :-			% say yes and show variables

	$show_variables(List),

	write(yes),			% horray

	Ok = yes,			% an alternative ?

	$askformore,			% check if the user wants it

	!.

$reply(_, Ok) :-			% no more alternative

	Ok = no,

	!.

	

$askformore :- get(X), skip(10), X \== 59. % 59 is ';'

	

$show_variables([]) :- !.

$show_variables([(Name, Variable)|L]) :-

	write(Name),

	write(' = '),

	write(Variable),

	nl,

	!,

	$show_variables(L).

	





% consult and friends

% we simply use the top level interpreter for the asserts and queries



[X|Y] :- $process_files([X|Y]).



$process_files([]) :- !.

$process_files([-File|Rest]) :- !, reconsult(File), $process_files(Rest).

$process_files([File|Rest]) :- !, consult(File), $process_files(Rest).



consult(File) :- !, $read_file(File, 0).



reconsult(File) :- !, $read_file(File, 1).



$read_file(File, R) :-

	Heap is heapused,

	Time is cputime,

	$reconsulting(R),

	$test_filename(File),		% check the file

	seeing(OldIn),

	telling(OldOut),

	see(File),			% open the file

	$do_loop,

	seen,				% close the file

	see(OldIn),

	tell(OldOut),

	$reconsulting(0),

	DiffTime is cputime - Time,

	DiffHeap is heapused - Heap,

	write(File),

	( R == 0 , write('  consulted ') ;

	  R == 1 , write('  reconsulted ')),

	write(DiffHeap), write(' bytes '),

	write(DiffTime), write(' msec.'),

	nl, !.



$do_loop :- $loop(filelevel).		% loop at filelevel

$do_loop.



$test_filename(user) :- !.		% this stream is always ok

$test_filename(File) :-

	not atom(File),			% invalid name

	nl,

	write('Invalid filename: '),

	write(File),

	nl,

	!, fail.

$test_filename(File) :-

	not exists(File),		% file not found

	nl,

	write('The file '),

	write(File),

	write(' does not exist.'),

	nl,

	!, fail.

$test_filename(_).			% is ok



%

% debugging hooks

%



leash(off) :- $leash(0).

leash(loose) :- $leash(1).

leash(half) :- $leash(5).

leash(tight) :- $leash(7).

leash(full) :- $leash(15).