view qutils.pl @ 6:ef5802225f99

get_message_or_timeout now uses deadline/1 option of thread_get_message if available.

:- module( qutils, 
		[	with_message/2
		,	with_message_or_timeout/4
		,	get_message_or_timeout/2
		,	send_with_size_limit/3
		]).

:- meta_predicate with_message(?,0).
:- meta_predicate with_message_or_timeout(+,?,0,0).

:- use_module(library(time)).
:- use_module(library(debug)).

%% get_message_or_timeout( +TimeOut, -Msg) is det.
%
%  Time-limited wait for next term in message queue.
%  Waits up to TimeOut seconds for the next message that 
%  unifies with Msg in the current thread.  If none arrives, 
%  then Msg is unified  with timeout. 
%  NB: may fail if Msg is bound on input.
get_message_or_timeout(inf,Msg) :- !, thread_get_message(Msg).

:- if(current_predicate(thread_get_message/3)).

:- if(current_predicate_option(thread_get_message/3,3,deadline(_))).

:- writeln('% compiling get_message_or_timeout/2 using deadline/1 option.').
get_message_or_timeout(Deadline,Msg) :- 
	thread_self(Thread),
	thread_get_message(Thread,Msg,[deadline(Deadline)]),
	debug(qutils,'got message: ~w.',[Msg]).

:- else.

:- writeln('% compiling get_message_or_timeout/2 using timeout/1 option.').
get_message_or_timeout(Deadline,Msg) :- 
	get_time(Now), 
	(	Now>=Deadline 
	-> Msg=timeout, 
		debug(qutils,'deadline already missed.',[])
	;	Timeout is Deadline-Now,
		thread_self(Thread),
		thread_get_message(Thread,Msg,[timeout(Timeout)]),
		debug(qutils,'got message: ~w.',[Msg])
	).	
:- endif.

:- else.

:- writeln('% compiling get_message_or_timeout/2 using alarm and message send.').
get_message_or_timeout(Deadline,Msg) :- 
	get_time(Now), 
	(	Now>=Deadline 
	-> Msg=timeout,
		debug(qutils,'deadline already missed.',[])
	;	thread_self(Thread),
		setup_call_cleanup(
			alarm_at(Deadline, thread_send_message(Thread,timeout), Id), 
			thread_get_message(Thread,Msg),
			time:remove_alarm_notrace(Id)),
		debug(qutils,'got message: ~w.',[Msg])
	).	

:-endif.


%% with_message( Msg, :Goal) is nondet.
%
%  Waits for next message, unify with Msg, and call Goal.
%  This procedure gets the next term out of the current thread's
%  message queue, waiting if necessary. If it is 'quit', then
%  it succeeds immediately leaving Msg unchanged. If it unifies
%  with Msg, then Goal is called. Otherwise, a message is printed
%  and the proceduce succeeds.
with_message(Temp,OnEvent) :-
	thread_get_message(Msg),
	(	Msg=quit -> true
	;	Msg=Temp -> call(OnEvent)
	;	writeln(template_mismatch(Temp,Msg))
	).

%% with_message_or_timeout( +TimeOut, Msg, :OnEvent, :OnTimeOut) is nondet.
%
%  Time limited wait for message with handler goals for either case.
%  Waits up to TimeOut seconds for next message, unify with Msg, 
%  and call OnEvent. If none arrives before TimeOut expires,
%  OnTimeOut is called instead. If the message is 'quit', it
%  just returns. If the message does not unify with Msg, some
%  text is printed and the proceduce succeeds.
with_message_or_timeout(T,Temp,OnEvent,OnTimeout) :- 
	get_message_or_timeout(T,Msg),
	(	Msg=quit    -> true
	;	Msg=timeout -> call(OnTimeout)
	;	Msg=Temp    -> call(OnEvent)
	;	writeln(template_mismatch(Temp,Msg))
	).

%% send_with_size_limit( +Max:natural, +Queue:queue_id, +Msg:term) is det.
%
%  Adds term to message queue unless queue is already full.
%  If message queue Queu already contains more than Max elements,
%  then "*" is printed and the procedure succeeds. NB. the message
%  is discarded.
send_with_size_limit(Max,Queue,Msg) :-
	message_queue_property(Queue,size(QSize)),
	(	QSize<Max -> thread_send_message(Queue,Msg)
	;	writeln('*')
	).