From 57c480e165eb714ad3975db8458126d7f456eab3 Mon Sep 17 00:00:00 2001
From: pmoura <pmoura@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Mon, 1 Jan 2007 19:40:17 +0000
Subject: [PATCH] Added predicates thread_property/1-2. Implementation is still
 incomplete as some thread properties are not yet internally represented.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1765 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 pl/threads.yap | 30 +++++++++++++++++++++++++++++-
 1 file changed, 29 insertions(+), 1 deletion(-)

diff --git a/pl/threads.yap b/pl/threads.yap
index dbb529a80..5748fb33f 100644
--- a/pl/threads.yap
+++ b/pl/threads.yap
@@ -57,7 +57,7 @@
 
 thread_create(Goal, Id) :-
 	G0 = thread_create(Goal, Id),
-	'$check_callable'(Goal, thread_create(Goal, Id)),
+	'$check_callable'(Goal, G0),
 	( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ),
 	'$thread_options'([], [], Stack, Trail, System, Detached, G0),
 	'$thread_new_tid'(Id),
@@ -594,6 +594,26 @@ thread_signal(Id, Goal) :-
 	erase(R).
 
 
+thread_property(Prop) :-
+	'$check_thread_property'(Prop, thread_property(Prop)),
+	'$thread_self'(Id),
+	'$thread_property'(Id, Prop).
+
+thread_property(Id, Prop) :-
+	(	nonvar(Id) ->
+		'$check_thread_or_alias'(Id, thread_property(Id, Prop))
+	;	true
+	),
+	'$check_thread_property'(Prop, thread_property(Id, Prop)),
+	'$check_thread_alias'(Id0, Id),
+	'$thread_property'(Id0, Prop).
+
+'$thread_property'(Id, alias(Alias)) :-
+	recorded('$thread_alias', [Id|Alias], _).
+'$thread_property'(Id, status(Status)) :-
+	'$thr_status'(Id, Status).
+
+
 threads :-
 	write('--------------------------------------------------------------'), nl,
 	format("~t~a~38+~n", 'Thread  Status'),
@@ -618,3 +638,11 @@ threads :-
 	integer(Term), \+ '$valid_thread'(Term), !,
 	'$do_error'(existence_error(thread, Term), Goal).
 '$check_thread_or_alias'(_,_).
+
+'$check_thread_property'(Term, _) :-
+	var(Term), !.
+'$check_thread_property'(alias(_), _) :- !.
+'$check_thread_property'(detached(_), _) :- !.
+'$check_thread_property'(status(_), _) :- !.
+'$check_thread_property'(Term, Goal) :-
+	'$do_error'(domain_error(thread_property, Term), Goal).