samer@0: :- module( qutils, 
samer@7: 		[	get_message_or_timeout/2
samer@0: 		,	send_with_size_limit/3
samer@0: 		]).
samer@0: 
samer@0: :- meta_predicate with_message(?,0).
samer@0: :- meta_predicate with_message_or_timeout(+,?,0,0).
samer@0: 
samer@2: :- use_module(library(time)).
samer@5: :- use_module(library(debug)).
samer@2: 
samer@11: % Older versions of SWI do not have alarm_at/3
samer@11: :- if(\+current_predicate(alarm_at/3)).
samer@11: %:- writeln('% Expanding alarm_at/3 to alarm_at/4.').
samer@11: user:goal_expansion(alarm_at(A,B,C), alarm_at(A,B,C,[])).
samer@11: :- endif.
samer@11: 
samer@0: %% get_message_or_timeout( +TimeOut, -Msg) is det.
samer@0: %
samer@0: %  Time-limited wait for next term in message queue.
samer@0: %  Waits up to TimeOut seconds for the next message that 
samer@0: %  unifies with Msg in the current thread.  If none arrives, 
samer@0: %  then Msg is unified  with timeout. 
samer@0: %  NB: may fail if Msg is bound on input.
samer@0: get_message_or_timeout(inf,Msg) :- !, thread_get_message(Msg).
samer@3: 
samer@9: % Older versions of SWI do not have thread_get_message/3
samer@3: :- if(current_predicate(thread_get_message/3)).
samer@3: 
samer@9: % we have thread_get_message/3 but we may or may not have the deadline/1 option
samer@6: :- if(current_predicate_option(thread_get_message/3,3,deadline(_))).
samer@6: 
samer@11: %:- writeln('% compiling get_message_or_timeout/2 using deadline/1 option.').
samer@8: 
samer@14: :- if((current_prolog_flag(version,Version),Version<60102)).
samer@14: 
samer@6: get_message_or_timeout(Deadline,Msg) :- 
samer@13: 	thread_self(Thread),
samer@13: 	(	thread_get_message(Thread,Msg,[deadline(Deadline)]) 
samer@13: 	->	debug(qutils,'got message: ~w.',[Msg])
samer@13: 	;	Msg=timeout).
samer@13: 
samer@13: 	%	(	get_time(Now), Now<Deadline
samer@13: 	%	->	thread_self(Thread),
samer@13: 	%		thread_get_message(Thread,Msg,[deadline(Deadline)]),
samer@13: 	%		debug(qutils,'got message: ~w.',[Msg])
samer@13: 	%	;	Msg=timeout
samer@13: 	%	).
samer@6: 
samer@6: :- else.
samer@6: 
samer@14: get_message_or_timeout(Deadline,Msg) :- 
samer@14: 	thread_self(Thread),
samer@14: 	(	thread_get_message(Thread,Msg,[deadline(Deadline)])
samer@14: 	->	debug(qutils,'got message: ~w.',[Msg])
samer@14: 	;	Msg=timeout
samer@14: 	).
samer@14: 
samer@14: :- endif.
samer@14: 
samer@14: :- else.
samer@14: 
samer@11: %:- writeln('% compiling get_message_or_timeout/2 using timeout/1 option.').
samer@3: get_message_or_timeout(Deadline,Msg) :- 
samer@3: 	get_time(Now), 
samer@5: 	(	Now>=Deadline 
samer@5: 	-> Msg=timeout, 
samer@5: 		debug(qutils,'deadline already missed.',[])
samer@3: 	;	Timeout is Deadline-Now,
samer@3: 		thread_self(Thread),
samer@5: 		thread_get_message(Thread,Msg,[timeout(Timeout)]),
samer@5: 		debug(qutils,'got message: ~w.',[Msg])
samer@3: 	).	
samer@6: :- endif.
samer@3: 
samer@3: :- else.
samer@3: 
samer@11: %:- writeln('% compiling get_message_or_timeout/2 using alarm and message send.').
samer@0: get_message_or_timeout(Deadline,Msg) :- 
samer@0: 	get_time(Now), 
samer@5: 	(	Now>=Deadline 
samer@5: 	-> Msg=timeout,
samer@5: 		debug(qutils,'deadline already missed.',[])
samer@0: 	;	thread_self(Thread),
samer@0: 		setup_call_cleanup(
samer@0: 			alarm_at(Deadline, thread_send_message(Thread,timeout), Id), 
samer@0: 			thread_get_message(Thread,Msg),
samer@5: 			time:remove_alarm_notrace(Id)),
samer@5: 		debug(qutils,'got message: ~w.',[Msg])
samer@0: 	).	
samer@0: 
samer@3: :-endif.
samer@3: 
samer@0: %% send_with_size_limit( +Max:natural, +Queue:queue_id, +Msg:term) is det.
samer@0: %
samer@0: %  Adds term to message queue unless queue is already full.
samer@0: %  If message queue Queu already contains more than Max elements,
samer@0: %  then "*" is printed and the procedure succeeds. NB. the message
samer@0: %  is discarded.
samer@0: send_with_size_limit(Max,Queue,Msg) :-
samer@0: 	message_queue_property(Queue,size(QSize)),
samer@0: 	(	QSize<Max -> thread_send_message(Queue,Msg)
samer@0: 	;	writeln('*')
samer@0: 	).
samer@0: