1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Lukas Degener, Fabian Noth (among others)
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15% Date: 23.10.2004
   16%:- if(\+ current_module(consult_server)).
   17
   18:- module(consult_server,[
   19	consult_server/1,
   20	consult_server/2,
   21	get_var_names/2
   22	]).   23
   24
   25%:-debug(consult_server(startup)).
   26%:-debug(consult_server(shutdown)).
   27%:-debug(consult_server(accept_loop)).
   28%:-debug(consult_server(handler)).
   29%:-debug(handle_command).
   30
   31
   32:- use_module(library(socket)).   33:- use_module(library(lists)).   34:- use_module(library(readutil)).   35:- use_module(library(charsio)).   36:- use_module(library(debug)).   37
   38option_default(interprete_lists,true).
   39option_default(canonical,false).
   40
   41
   42
   43:- dynamic option_value/2.   44:- thread_local option_value/2.   45option(Name,Value):-
   46    option_value(Name,AValue),
   47    !,
   48    Value=AValue.
   49option(Name,Value):-
   50	option_default(Name,Value).
   51	
   52set_option(Name,Value):-
   53	retractall(option_value(Name,_)),
   54	assert(option_value(Name,Value)).
   55
   56unset_option(Name):-	
   57	retractall(option_value(Name,_)).
   58	
   59clear_options:-
   60	retractall(option_value(_,_)).	
   61		    
   62
   63
   64create_lock_file(Filename):-
   65  delete_lock_file(Filename),
   66	(	exists_file(Filename)
   67	->	debug(consult_server(init), 'Found existing lock file ~w.~n Shutting down...~n', [Filename]),		
   68		dmsg(thread_signal(main,halt))
   69	;	open(Filename, write, Stream),
   70		call_cleanup(
   71			(	write(Stream,Filename),
   72				nl(Stream)
   73			),
   74			close(Stream)
   75		)
   76	).
   77	
   78delete_lock_file(Filename):-
   79	(	exists_file(Filename)
   80	->	delete_file(Filename)
   81	;	true
   82	).
   83
   84
   85
   86	
   87
   88
   89:- multifile process_shutdown_hook/0.   90:- dynamic process_shutdown_hook/0.   91
   92process_shutdown_hook.
   93
   94call_shutdown_hook:-
   95    forall(process_shutdown_hook,true).
   96    
   97do_shutdown:-
   98   	debug(consult_server(shutdown), 'begin shutdown ~n', []),
   99   	call_shutdown_hook,
  100    %join any thread that is not main.
  101    (	current_thread(Id,_),
  102	    do_shutdown_X(Id),
  103       	fail
  104	;	debug(consult_server(shutdown), 'shutdown complete~n',[]),
  105		threads,
  106		dmsg(halt)
  107	).
  108do_shutdown_X(Id):-
  109    Id\==main,
  110    debug(consult_server(shutdown), 'joining ~w~n',[Id]),
  111    thread_join(Id,Status),
  112    debug(consult_server(shutdown), 'successfully joined ~w, status: ~w ~n', [Id,Status]).
  113    
  114	
  115consult_server(Port):- 
  116	tcp_socket(ServerSocket),
  117	tcp_setopt(ServerSocket, reuseaddr),
  118	tcp_bind(ServerSocket, Port),
  119	tcp_listen(ServerSocket, 5),
  120	atomic_list_concat([consult_server,'@',Port],Alias),
  121	recordz(process_flag,port(Port),_),
  122	thread_create(accept_loop(ServerSocket), _,[alias(Alias)]).
  123
  124consult_server(Port,Lockfile):-
  125	consult_server(Port),
  126	create_lock_file(Lockfile).
  127
  128
  129	
  130accept_loop(ServerSocket):-    
  131	catch(
  132		accept_loop_impl(ServerSocket),
  133		Error,
  134		(
  135			debug(consult_server(accept_loop), 'accept loop encountered an error:~w~n. Shutting down...~n',[Error]),
  136			thread_signal(main,halt)
  137		)
  138	),
  139	debug(consult_server(shutdown), 'signaling main to shutdown... ~n',[]),
  140	thread_signal(main,do_shutdown),
  141	debug(consult_server(shutdown), 'shutdown signal send, exit current thread. ~n',[]).
  142
  143
  144accept_loop_impl(ServerSocket) :-
  145	debug(consult_server(accept_loop), 'enter accept_loop_impl~n', []),
  146	tcp_accept(ServerSocket, Slave, Peer),
  147	debug(consult_server(accept_loop),'accepted inbound connection~n',[]),
  148	debug(consult_server(accept_loop),'connect from host ~w~n',[Peer]),
  149	accept_loop_impl_X(ServerSocket,Slave).
  150
  151accept_loop_impl_X(ServerSocket,Slave):-
  152    debug(consult_server(shutdown),'Checking for shutdown flag. ~n',[]),
  153    recorded(process_flag,shutdown,_),    
  154    !,
  155    debug(consult_server(shutdown),'Shutdown flag is set. We are closing down. ~n',[]),
  156    tcp_close_socket(Slave),
  157    tcp_close_socket(ServerSocket).
  158
  159accept_loop_impl_X(ServerSocket,Slave):-	
  160	debug(consult_server(accept_loop),'enter accept_loop_impl_X~n',[]),
  161	tcp_open_socket(Slave, InStream, OutStream),	
  162	debug(consult_server(accept_loop),'socket opened~n',[]),
  163	unused_thread_name(handle_client,'',Alias),
  164	debug(consult_server(accept_loop),'handler thread alias: ~w~n',[Alias]),		
  165	garbage_collect,
  166	debug(consult_server(accept_loop),'garbage collected~n',[]),
  167	debug(consult_server(accept_loop),'creating thread ~w.~n',[Alias]),
  168	thread_create(handle_client(InStream, OutStream), _ , [alias(Alias),detached(true)]),
  169	debug(consult_server(accept_loop),'successfully created thread ~w.~n',[Alias]),	
  170	accept_loop_impl(ServerSocket).
  171
  172handler_at_exit(InStream,OutStream):-
  173	debug(consult_server(handler),'Thread is exiting. Trying to close the connection...~n',[]),
  174	catch(
  175		(	byebye(InStream,OutStream),
  176			debug(consult_server(handler),'Connection closed successfully. ~n',[])
  177		),
  178		E,
  179		debug(consult_server(handler),'Error encountered while closing the connection: ~w.~n',[E])
  180	).
  181
  182    
  183	
  184handle_client(InStream, OutStream):-    
  185	thread_at_exit(handler_at_exit(InStream,OutStream)),			
  186    set_stream(InStream,encoding(utf8)),
  187    set_stream(OutStream,encoding(utf8)),
  188	repeat,
  189		debug(consult_server(handler),'start hanlde_client~n',[]),
  190		catch(
  191			handle_client_impl(InStream,OutStream),
  192			Error,
  193			(	handle_exception(InStream,OutStream,Error,Action),
  194				!,
  195				Action==stop
  196			)				
  197		),
  198	!,		
  199	debug(consult_server(handler),'Thread exiting...~n',[]).    
  200	
  201handle_client_impl(InStream, OutStream):-
  202    repeat,
  203		request_line(InStream,OutStream,'GIVE_COMMAND',Command),
  204		( handle_command(InStream,OutStream,Command,Next)
  205		->report_ok(OutStream)
  206		;	%report_error(OutStream, 'failed, sorry.'),
  207			Next=continue
  208		),
  209	Next==stop,
  210	!.
  211		
  212
  213		
  214handle_command(_,_,'BYE',stop) :-	
  215	!.
  216handle_command(_,_,'SHUTDOWN',stop):-	
  217	!,
  218	% stop accept loop:
  219	% we set the shutdown flag (which is read by the accept loop)
  220	% then we have to kick the accept loop out of the tcp_accept/3 call.
  221	% we do this by simply opening a connection to the listen port.
  222
  223	recordz(process_flag,shutdown,_),
  224	recorded(process_flag,port(Port),_),
  225	tcp_socket(Socket),
  226	tcp_connect(Socket,localhost:Port),
  227	tcp_close_socket(Socket).
  228handle_command(_,_,'',continue):-
  229	!,
  230	clear_options.
  231handle_command(_,OutStream,'PING',continue):-
  232	!,
  233	current_prolog_flag(pid,Pid),
  234    thread_self(Alias),
  235	my_format(OutStream,'PONG ~w:~w~n',[Pid,Alias]).
  236handle_command(InStream,OutStream,'ENTER_BATCH',continue):-
  237	!,
  238	my_format(OutStream,'GO_AHEAD~n',[]),
  239	repeat,
  240		handle_batch_messages(OutStream),
  241		my_read_command(InStream,Term),
  242		handle_batch_command(Term,InStream,OutStream),
  243		Term=end_of_batch,!.
  244handle_command(InStream,OutStream,'QUERY',continue):-
  245	!,
  246	debug('handle_command', 'before my_format', []),
  247	my_format(OutStream,'GIVE_TERM~n',[]),	
  248	debug('handle_command', 'after my_format', []),
  249	call_save(OutStream,my_read_term(InStream,Term,[variable_names(Vars)/*,double_quotes(string)*/])),
  250	( 
  251	(debug('handle_command', 'before iterate_solutions ~w', [Term]),
  252	iterate_solutions(InStream,OutStream,Term,Vars),
  253	debug('handle_command', 'after iterate_solutions ~w', [Term]))
  254	; true
  255	).
  256handle_command(InStream,OutStream,'QUERY_ALL',continue):-
  257	!,
  258	my_format(OutStream,'GIVE_TERM~n',[]),
  259	call_save(OutStream,my_read_term(InStream,Term,[variable_names(Vars)/*,double_quotes(string)*/])),		
  260	(
  261		all_solutions(OutStream,Term,Vars)
  262	;
  263		true
  264	).
  265handle_command(InStream,OutStream,'SET_OPTION',continue):-
  266	!,
  267	request_line(InStream,OutStream,'GIVE_SYMBOL',Symbol),
  268	request_line(InStream,OutStream,'GIVE_TERM',Term),
  269	call_save(OutStream,set_option(Symbol,Term)).
  270handle_command(InStream,OutStream,'GET_OPTION',continue):-
  271	!,
  272	request_line(InStream,OutStream,'GIVE_SYMBOL',Symbol),
  273	call_save(OutStream,
  274		(	option(Symbol,Term),
  275			my_format(OutStream,'~w~n',[Term])
  276		)
  277	).
  278
  279
  280my_read_command(InStream,Term):-
  281    my_read_term(InStream,Term,[]).
  282
  283my_read_goal(InStream,Term,Vars):-
  284    my_read_term(InStream,Term,[variable_names(Vars)]).
  285
  286		
  287handle_batch_messages(OutStream):-
  288    repeat,    
  289    (	thread_peek_message(batch_message(Message)),
  290    	debug(consult_server(handler),'recieved message: ~w~n',[Message]),
  291    	handle_batch_message(Message, OutStream)
  292    ->	thread_get_message(batch_message(Message)), 
  293		debug(consult_server(handler),'dequeued message: ~w~n',[Message]),
  294    	fail
  295    ;	true
  296    ),
  297    !.
  298    
  299%note on aborts: an abort request is complete if BOTH the async abort message aswell as the
  300%sync abort marker have been recieved. I originally assumed that the async message would always 
  301%preceed the marker, but it seems to be more tricky. So i will now handle this symetrically.
  302
  303record_abort_request(Type,Id):-
  304    thread_self(Thread),
  305    (	recorded(process_batch_abort,request(Thread,Type,Id),_)
  306    ->	true
  307    ;	recordz(process_batch_abort,request(Thread,Type,Id),_)
  308    ).
  309    
  310
  311erase_abort_request(Type,Id):-
  312    thread_self(Thread),
  313    (	recorded(process_batch_abort,request(Thread,Type,Id),Ref)
  314    ->	erase(Ref)
  315    ;	true
  316    ).
  317    
  318abort_requested(Type,Id):-
  319	thread_self(Thread),
  320	recorded(process_batch_abort,request(Thread,Type,Id),_).    
  321
  322aborting:-
  323    abort_requested(async,_).
  324
  325send_abort_complete(Id,OutStream):-    
  326   	my_format(OutStream, 'ABORT_COMPLETE: ~w~n',[Id]).
  327    
  328handle_batch_message(abort(Id),OutStream):-    
  329	debug(consult_server,'recieved abort (async, id=~w)~n',[Id]),
  330	(	abort_requested(sync,Id)
  331	->	erase_abort_request(sync,Id),
  332		send_abort_complete(Id,OutStream)
  333	;	record_abort_request(async,Id),
  334		debug(consult_server(handler),'recorded abort (async, id=~w)~n',[Id])
  335	).
  336handle_batch_command(set_option(Option,Value),_,OutStream):-
  337	call_save(OutStream,set_option(Option,Value)).
  338handle_batch_command(abort(Id),_,OutStream):-
  339    debug(consult_server(handler),'recieved abort (sync, id=~w)~n',[Id]),
  340	(	abort_requested(async,Id)
  341	->	erase_abort_request(async,Id),
  342		send_abort_complete(Id,OutStream)
  343	;	record_abort_request(sync,Id),
  344	    debug(consult_server(handler),'recorded abort (sync, id=~w)~n',[Id])
  345	).
  346handle_batch_command(join(Id),_,OutStream):-
  347	my_format(OutStream, 'JOIN_COMPLETE: ~w~n',[Id]).
  348handle_batch_command(end_of_batch,InStream,OutStream):-
  349	forall(abort_requested(async,Id),handle_batch_command(abort(Id),InStream,OutStream)),
  350	forall(abort_requested(sync,Id),handle_batch_message(abort(Id),OutStream)),
  351	my_format(OutStream, 'END_OF_BATCH_COMPLETE~n',[]).
  352handle_batch_command(query_once(Id),InStream,OutStream):-
  353	aborting,
  354    !,
  355    my_read_goal(InStream,_,_),    
  356    my_format(OutStream, 'SKIPPING_QUERY: ~w~n',[Id]).
  357handle_batch_command(query_all(Id),InStream,OutStream):-
  358    aborting,
  359    !,
  360    my_read_goal(InStream,_,_),
  361    my_format(OutStream, 'SKIPPING_QUERY: ~w~n',[Id]).
  362    
  363handle_batch_command(query_once(Id),InStream,OutStream):-
  364    my_format(OutStream, 'RESULTS_FOR_QUERY: ~w~n',[Id]),
  365    call_save(OutStream,(
  366    		my_read_goal(InStream,Goal,Vars),
  367    		one_solution(OutStream,Goal,Vars)
  368    		)
  369    	).
  370handle_batch_command(query_all(Id),InStream,OutStream):-
  371    my_format(OutStream, 'RESULTS_FOR_QUERY: ~w~n',[Id]),
  372    call_save(OutStream,(
  373    		my_read_goal(InStream,Goal,Vars),
  374    		solutions_weak_until_cut(OutStream,Goal,Vars)
  375    		)
  376    	).
  377
  378call_save(OutStream, Goal):-
  379    catch(Goal,
  380	    Error,
  381    		report_error(OutStream,Error)
  382    	).
  383
  384solutions_weak_until_cut(OutStream,Term,Vars):-
  385	(	solutions_until_cut(OutStream,Term,Vars)
  386	->	my_format(OutStream, 'CUT~n',[])
  387	;	solutions_yes_or_no(OutStream)
  388	).
  389
  390
  391solutions_until_cut(OutStream,Term,Vars):-
  392	user:Term,
  393	nb_setval(hasSolutions,1),
  394	print_solution(OutStream,Vars),
  395	goal_was_cut(OutStream),!.	
  396
  397goal_was_cut(OutStream):-
  398	handle_batch_messages(OutStream),
  399	aborting.
  400	
  401solutions_yes_or_no(OutStream):-
  402	(	nb_current(hasSolutions,1)
  403	->	my_format(OutStream,'YES~n',[]),
  404		nb_delete(hasSolutions)
  405	; 	my_format(OutStream,'NO~n',[])
  406	).
  407
  408	
  409	
  410
  411
  412one_solution(OutStream,Term,Vars):-
  413	( 	user:Term
  414	->	consult_server:print_solution(OutStream,Vars),
  415		my_format(OutStream,'YES~n',[])
  416	; 	my_format(OutStream,'NO~n',[])
  417	).
  418	
  419	
  420all_solutions(OutStream,Term,Vars):-
  421	user:forall(
  422		catch(Term,E,throw(wrapped(E))),
  423		(
  424			consult_server:print_solution(OutStream,Vars),
  425			nb_setval(hasSolutions,1)
  426		)		
  427	),
  428	(	nb_current(hasSolutions,1)
  429	->	my_format(OutStream,'YES~n',[]),
  430		nb_delete(hasSolutions)
  431	;	my_format(OutStream,'NO~n',[])
  432	).
  433	
  434	
  435iterate_solutions(InStream,OutStream,Term,Vars):-
  436	( user:forall(
  437			catch(Term,E,throw(wrapped(E))),
  438			(
  439				consult_server:print_solution(OutStream,Vars),	
  440				consult_server:request_line(InStream,OutStream,'MORE?','YES')										
  441			)
  442		)
  443	->my_format(OutStream,'NO~n',[])
  444	; my_format(OutStream,'YES~n',[])
  445	).
  446	
  447	
  448	
  449	
  450print_solution(OutStream,Vars):-
  451	forall(
  452		(member(Key=Val,Vars), filter_variable(Val)),
  453		print_binding(OutStream,Key,Val,Vars)
  454	),
  455	my_format(OutStream,'END_OF_SOLUTION~n',[]).
  456	
  457filter_variable(_) :-
  458	option(unbound_variables,true), !.
  459	
  460filter_variable(Val) :-
  461	nonvar(Val).
  462	
  463print_binding(Out,Key,Val,Vars):-
  464		my_write(Out,'<'),
  465		write(Out,Key),
  466		my_write(Out, '>'),		
  467		print_value(Out,Val,Vars),		
  468		nl(Out).
  469
  470print_values([],_,_). 
  471print_values([Head|Tail],Out,Vars):-
  472	print_value(Out,Head,Vars),		
  473	print_values(Tail,Out,Vars).
  474	
  475
  476print_value(Out,Val,Vars):-    	
  477	option(canonical,true),
  478	!,
  479	my_write(Out,'<'),
  480	(write_escaped(Out,Val,Vars);true),
  481	my_write(Out, '>').
  482print_value(Out,Val,Vars):-    	
  483	( 	is_list(Val), option(interprete_lists,true)
  484 	->	my_write(Out,'{'),
  485		print_values(Val,Out,Vars),
  486		my_write(Out, '}')		
  487	;	my_write(Out,'<'),
  488		write_escaped(Out,Val,Vars),
  489		my_write(Out, '>')
  490	).
  491
  492
  493
  494handle_exception(InStream,OutStream,Error,Action):-
  495    debug(consult_server(handler), 'handle_excpetion (pre): Up:~w, Down:~w, Error:~w~n',[InStream,OutStream,Error]),
  496    handle_exception_X(InStream,OutStream,Error,Action),
  497    debug(consult_server(handler), 'handle_excpetion (post): Action:~w~n',[Action]).	
  498    
  499handle_exception_X(InStream,OutStream,Error,Action):-
  500	var(Error),
  501	!,
  502	handle_exception(InStream,OutStream,unbound_error_term,Action).	
  503	
  504
  505	
  506handle_exception_X(_InStream,OutStream,peer_reset,continue):-
  507	catch(
  508		(
  509			my_format(OutStream,'RESET~n',[]),
  510			report_ok(OutStream)
  511		),							
  512		_,(
  513		%	shut_down(InStream,OutStream),
  514			fail
  515			)
  516	),
  517	!.
  518	
  519handle_exception_X(_InStream,OutStream,wrapped(Error),continue):-
  520	catch(		
  521		report_error(OutStream,Error),					
  522		_,(
  523%			shut_down(InStream,OutStream),
  524			fail
  525			)
  526	),
  527	!.
  528	
  529handle_exception_X(_InStream,OutStream,fatal_read_term_error(Error),stop):-
  530	catch(		
  531		report_error(OutStream,Error),					
  532		_,(
  533%			shut_down(InStream,OutStream),
  534			fail
  535			)
  536	),
  537	!.
  538	
  539handle_exception_X(_InStream,_OutStream,Error,stop):-
  540	debug(consult_server(handler),'Unhandled Exception :~w~n Trying to shut down...~n',[Error]).
  541	
  542	
  543	
  544report_ok(OutStream):-
  545	my_format(OutStream,'OK~n',[]).	
  546	
  547report_error(OutStream, Error):-
  548	(	var(Error)
  549	->	my_format(OutStream,'ERROR: unbound error term~n',[])
  550	;	my_format(OutStream,'ERROR: ~w~n',[Error])
  551	).			
  552	
  553		
  554byebye(InStream,OutStream):-
  555	debug(consult_server,'byebye called~n',[]),
  556	(	is_stream(OutStream)
  557	->	debug(consult_server(handler),'Downstream is a stream: ~w~n',[OutStream]),
  558		debug(consult_server(handler),'sending BYE downstream: ~w~n',[OutStream]),
  559		my_format(OutStream,'BYE~n',[]),
  560		debug(consult_server(handler),'closing downstream: ~w~n',[OutStream]),		
  561		catch(close(OutStream),E,
  562			debug(consult_server(handler),'Problem closing downstream: ~w~n',[E])
  563		)
  564	;	debug(consult_server(handler),'Downstream is no stream: ~w~n',[OutStream])
  565	),
  566	(	is_stream(InStream)	
  567	->	debug(consult_server(handler),'Upstream is a stream: ~w~n',[InStream]),
  568		debug(consult_server(handler),'closing upstream: ~w~n',[InStream]),		
  569		catch(close(InStream),E,
  570			debug(consult_server(handler),'Problem closing upstream: ~w~n',[E])
  571		)
  572	;	debug(consult_server(handler),'Upstream is no stream: ~w~n',[InStream])
  573	).
  574	
  575	
  576
  577	
  578	
  579	
  580codes_or_eof_to_atom(end_of_file,_):-
  581	throw(end_of_file).
  582	
  583codes_or_eof_to_atom(Codes,Atom):-
  584	atom_codes(Atom,Codes).
  585	
  586	
  587count_thread(Prefix,Count):-
  588	findall(A,
  589		(	my_current_thread(A),
  590			atom_concat(Prefix,_,A),
  591			debug(consult_server(handler),'There is e.g. a thread named ~w~n',[A])
  592		),
  593		Bag
  594	),	 
  595	length(Bag,Count).
  596	
  597unused_thread_name(Prefix,Suffix,Name):-
  598	unused_thread_name(Prefix,Suffix,0,Name).	
  599	
  600unused_thread_name(Prefix,Suffix,Try,Name):-
  601	atomic_list_concat([Prefix,Try,Suffix],A),
  602	(	my_current_thread(A)
  603	->	plus(Try,1,Next),
  604		unused_thread_name(Prefix,Suffix,Next,Name)
  605	;	Name=A			
  606	).
  607	
  608my_current_thread(A) :-
  609  catch(thread_property(A,status(_)), error(existence_error(thread, _), _), fail).
  610	
  611	
  612	
  613request_line(InStream, OutStream, Prompt, Line):-
  614	my_format(OutStream,'~w~n',[Prompt]),
  615	with_interrupts(5,read_line_to_codes(InStream,LineCodes)),
  616	codes_or_eof_to_atom(LineCodes,Line),
  617	debug(consult_server(traffic),'(Up:~w, read_line_to_codes)<<< ~w~n',[InStream,Line]).
  618	
  619	
  620	
  621my_read_term(InStream,Term,Options):-
  622	with_interrupts(5,read_term(InStream,Term,Options)),
  623	debug(consult_server(traffic),'(Up:~w read_term) <<<~w~n',[InStream,Term]).
  624
  625my_write_term(OutStream,Elm,Options):-
  626	debug(consult_server(traffic),'(Down:~w write_term) >>>~w~n',[OutStream,Elm]),  
  627	write_term(OutStream,Elm,Options),
  628	nl(OutStream).
  629my_write(OutStream,Term):-
  630	debug(consult_server(traffic),'(Down:~w, write)>>>~w~n',[OutStream,Term]),
  631	write(OutStream,Term).	
  632	
  633my_format(OutStream,Format,Args):-
  634	atom_concat('(Down:~w, format) >>>',Format,Format2),
  635	atom_concat(Format2,'~n',Format3),
  636	debug(consult_server(traffic),Format3,[OutStream|Args]),
  637	format(OutStream,Format,Args),
  638	flush_output(OutStream).
  639
  640my_format(Format,Args):-
  641    debug(consult_server,Format,Args).
  642	
  643
  644write_escaped(Out,Term,Vars):-
  645	with_output_to(
  646		atom(Atom),
  647		(	current_output(O),
  648			write_term(O, Term, [ignore_ops(true),quoted(true),variable_names(Vars)])
  649		)
  650	),
  651    escape_chars_in_atom(Atom, EscapedAtom),
  652    my_write(Out,EscapedAtom).
  653    
  654escape_chars_in_atom(Atom, EscapedAtom) :-
  655	atom_chars(Atom, List),
  656	escape_chars_impl(List, EscapedList),
  657	atom_chars(EscapedAtom, EscapedList).
  658	
  659escape_chars_impl([], []) :- !.
  660
  661% '<' --> '&lt;'
  662escape_chars_impl(['<'|Tail], ['&', 'l', 't', ';'|NewTail]) :-
  663	escape_chars_impl(Tail, NewTail).
  664	
  665% '>' --> '&gt;'
  666escape_chars_impl(['>'|Tail], ['&', 'g', 't', ';'|NewTail]) :-
  667	escape_chars_impl(Tail, NewTail).
  668	
  669% '{' --> '&cbo;'
  670escape_chars_impl(['{'|Tail], ['&', 'c', 'b', 'o', ';'|NewTail]) :-
  671	escape_chars_impl(Tail, NewTail).
  672	
  673% '}' --> '&cbc;'
  674escape_chars_impl(['}'|Tail], ['&', 'c', 'b', 'c', ';'|NewTail]) :-
  675	escape_chars_impl(Tail, NewTail).
  676	
  677% '&' --> '&amp;'
  678escape_chars_impl(['&'|Tail], ['&', 'a', 'm', 'p', ';'|NewTail]) :-
  679	escape_chars_impl(Tail, NewTail).
  680	
  681% '"' --> '&quot;'
  682escape_chars_impl(['"'|Tail], ['&', 'q', 'u', 'o', 't', ';'|NewTail]) :-
  683	escape_chars_impl(Tail, NewTail).
  684	
  685% '\'' --> '&apos;'
  686escape_chars_impl(['\''|Tail], ['&', 'a', 'p', 'o', 's', ';'|NewTail]) :-
  687	escape_chars_impl(Tail, NewTail).
  688
  689% other chars don't need to be translated
  690escape_chars_impl([Char|Tail], [Char|NewTail]) :-
  691	escape_chars_impl(Tail, NewTail).
  692	
  693	
  694write_term_to_memfile(Term,Memfile,Vars):-
  695	new_memory_file(Memfile),
  696	open_memory_file(Memfile,write,Stream),
  697	call_cleanup(
  698		/*(	option(canonical,true)
  699		->	write_canonical(Stream,Term)
  700		;	write(Stream,Term)
  701		),*/
  702		write_term(Stream,Term,[ignore_ops(true),quoted(true),variable_names(Vars)]),
  703		close(Stream)
  704	).
  705
  706escape_stream(In,Out):-
  707    repeat,	    
  708    (	at_end_of_stream(In)
  709    ->	!
  710    ;   get_char(In,Char),    	
  711	    write_escaped_char(Char,Out),
  712	    fail
  713	).
  714	
  715
  716write_escaped_char('<',Out):-
  717	!,
  718	write(Out,'&lt;').
  719write_escaped_char('>',Out):-
  720	!,
  721	write(Out,'&gt;').
  722write_escaped_char('{',Out):-
  723	!,
  724	write(Out,'&cbo;').
  725write_escaped_char('}',Out):-
  726	!,
  727	write(Out,'&cbc;').
  728write_escaped_char('&',Out):-
  729	!,
  730	write(Out,'&amp;').
  731write_escaped_char('"',Out):-
  732	!,
  733	write(Out,'&quot;').
  734write_escaped_char('\'',Out):-
  735	!,
  736	write(Out,'&apos;').
  737write_escaped_char(C,Out):-
  738	put_char(Out,C).	
  739/*		
  740with_interrupts(S,Goal):-
  741	repeat,
  742	    catch(
  743	    	(	call_with_time_limit(S,Goal)
  744	    	->	true
  745	    	;	!, fail
  746	    	),
  747	    	time_limit_exceeded,
  748	    	fail
  749	    ),
  750   !.
  751*/
  752with_interrupts(_,Goal):-Goal.
  753/*
  754user:prolog_exception_hook(In,_Out,_Frame,CFrame):-
  755	(	CFrame == none
  756	->	format("uncaught exception: ~w~n",[In]),
  757		backtrace(50),
  758		fail
  759	;		
  760	)
  761	*/	
  762
  763:- use_module(library(apply)).  764    
  765get_var_names(Goal, _) :-
  766    not(atomic(Goal)),
  767    !,
  768    throw('first argument has to be atomic').
  769    
  770get_var_names(Goal, VarNames) :-
  771    format(atom(Query), '~w.', [Goal]),
  772    open_chars_stream(Query,Stream),
  773    read_term(Stream,_,[variable_names(VarNameList)]),
  774    maplist(extract_var_name, VarNameList, ExtractedList),
  775    list_2_comma_separated_list(ExtractedList,VarNames).
  776    
  777extract_var_name(=(VarName, _), VarName) :- !.
  778extract_var_name(VarName, VarName) :- !.
  779
  780list_2_comma_separated_list([],'') :- !.
  781list_2_comma_separated_list([Element],Element) :- !.
  782list_2_comma_separated_list([Element|[H|T]],ElementComma) :-
  783	list_2_comma_separated_list([H|T],RestAtom),
  784	format(atom(ElementComma),'~w,~w',[Element,RestAtom]).
  785
  786%:- endif.