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