1% bprepl : evaluator service to run in B-Prolog
    2%
    3% Sits on standard input reading terms and sending replies
    4% Query must be of the form:
    5%    query(+Id,+Query,+Vars)
    6% The service calls Query and replies with
    7%    query(+Id,+Vars,+Reply)
    8% Reply can be true, fail, or throw(Exception).
    9% Queries must be semideterministic as multiple solutions
   10% are not suppoerted at present.
   11
   12:- dynamic logging/0.   13
   14repl(In,Out) :-
   15	once((repeat,read_valid_term(In,Term,Vars))),
   16	(logging, write('-> '), labelvars(Vars), reply_term(Term), fail; true),
   17	(	Term=end_of_file -> true
   18	;	interp(Term,Reply),
   19		labelvars(Vars),
   20		(logging -> write('<- '), reply_term(Reply); true),
   21		reply_term(Out,Reply),
   22		repl(In,Out)
   23	).
   24
   25read_valid_term(Stream,Term,Vars) :-
   26	catch( read_term(Stream,Term,[variable_names(Vars)]),
   27		Ex,(writeln(Ex),fail)).
   28
   29reply_term(T) :- current_output(S), reply_term(S,T).
   30reply_term(S,T) :- write_canon(S,T), write(S,'.\n'). 
   31
   32% interp is not allowed to fail or throw and exception
   33interp(query(Id,Query,Vars),query(Id,Vars,Reply)) :- !,
   34	catch((call(Query) -> Reply=true; Reply=fail), E, Reply=throw(E)).
   35interp(_,unrecognised).
   36
   37% this is so variables in reply match names of variables in query
   38labelvars([N=V|T]) :- (var(V) -> V='$VAR'(N); true), labelvars(T).
   39labelvars([]).
   40
   41% built in write_canonical doesn't handle $VAR terms well
   42write_canon(S,'$VAR'(N)) :- !, write(S,N).
   43write_canon(S,[]) :-!, write(S,[]).
   44write_canon(S,[H|T]) :- !, 
   45	write(S,'['), write_canon(S,H),
   46	write_list_tail(S,T),
   47	write(S,']').
   48
   49write_canon(S,A) :- float(A), !, format(S,'~15g',[A]).
   50write_canon(S,A) :- atomic(A), !, writeq(S,A).
   51write_canon(S,A) :- A=..[F,H|T], writeq(S,F), 
   52	write(S,'('), write_canon(S,H),
   53	write_list_tail(S,T),
   54	write(S,')').
   55
   56write_list_tail(_,[]).
   57write_list_tail(S,[H|T]) :- 
   58	write(S,', '), write_canon(S,H), 
   59	write_list_tail(S,T).
   60
   61
   62open_log(file(File),Con) :- open(File,append,Con).
   63
   64main :- main(file('bprepl.log')).
   65
   66main(LogSpec) :- 
   67	open_log(LogSpec,Con),
   68	set_output(Con),
   69	writeln('-- starting'),
   70	catch((
   71		reply_term(user_output,repl(ready)),
   72		repl(user_input,user_output)),
   73		Ex,(write('** exception: '), writeln(Ex))),
   74	writeln('-- terminating'),
   75	set_output(user_output).
   76
   77log(on) :- logging -> true; assert(logging).
   78log(off) :- retractall(logging).
   79
   80% PRISM stuff
   81
   82:- dynamic dynamic_values/2.   83
   84set_dynamic_values(I,V) :-
   85	(	dynamic_values(I,V2)
   86	->	(	V=V2 -> true
   87		; 	retractall(dynamic_values(I,_)), 
   88			assert(dynamic_values(I,V))
   89		)
   90	;	assert(dynamic_values(I,V))
   91	)