1:- module(
    2  thread_ext,
    3  [
    4    create_detached_thread/1, % :Goal_0
    5    create_detached_thread/2, % +Alias, :Goal_0
    6    thread_list/0,
    7    thread_name/2,            % ?Id:handle, ?Name:atom
    8    thread_self_property/1,   % ?Property
    9    threaded_maplist_1/2,     %     :Goal_1, ?Args1
   10    threaded_maplist_1/3,     % +N, :Goal_1, ?Args1
   11    threaded_maplist_2/3,     %     :Goal_1, ?Args1, ?Args2
   12    threaded_maplist_2/4      % +N, :Goal_1, ?Args1, ?Args2
   13  ]
   14).   15:- reexport(library(thread)).

Extended support for threads

Extends support for threads in the SWI-Prolog standard library.

*/

   23:- use_module(library(aggregate)).   24:- use_module(library(apply)).   25:- use_module(library(lists)).   26
   27:- meta_predicate
   28    create_detached_thread(0),
   29    create_detached_thread(+, 0),
   30    threaded_maplist_1(1, ?),
   31    threaded_maplist_1(+, 1, ?),
   32    threaded_maplist_2(2, ?, ?),
   33    threaded_maplist_2(+, 2, ?, ?).
 create_detached_thread(:Goal_0) is det
 create_detached_thread(+Alias:atom, :Goal_0) is det
   42create_detached_thread(Goal_0) :-
   43  thread_create(Goal_0, _, [detached(true)]).
   44
   45
   46create_detached_thread(Alias, Goal_0) :-
   47  thread_create(Goal_0, _, [alias(Alias),detached(true)]).
 thread_list is det
   53thread_list :-
   54  aggregate_all(
   55    set(Name-Status),
   56    (
   57      thread_property(Id, status(Status)),
   58      thread_name(Id, Name)
   59    ),
   60    Pairs
   61  ),
   62  forall(
   63    member(Name-Status, Pairs),
   64    format(user_output, "~a\t~a\n", [Name,Status])
   65  ).
 thread_name(+Id:handle, -Alias:atom) is det
   71thread_name(Id, Alias) :-
   72  thread_property(Id, alias(Alias)), !.
   73thread_name(Id, Id).
 thread_self_property(+Property:compound) is semidet
thread_self_property(-Property:compound) is multi
   80thread_self_property(Property) :-
   81  thread_self(Thread),
   82  thread_property(Thread, Property).
 threaded_maplist_1(:Goal_1, ?Args1:list) is det
 threaded_maplist_1(+N:positive_integer, :Goal_1, ?Args1:list) is det
 threaded_maplist_2(:Goal_2, ?Args1:list, ?Args2:list) is det
 threaded_maplist_2(+N:positive_integer, :Goal_2, ?Args1:list, ?Args2:list) is det
   91threaded_maplist_1(Mod:Goal_1, Args1) :-
   92  current_prolog_flag(cpu_count, N),
   93  threaded_maplist_1(N, Mod:Goal_1, Args1).
   94
   95
   96threaded_maplist_1(N, Mod:Goal_1, Args1) :-
   97  maplist(make_goal_1(Mod:Goal_1), Args1, Goals),
   98  concurrent(N, Goals, []).
   99
  100make_goal_1(Mod:Goal_1, Arg1, Mod:Goal_0) :-
  101  Goal_1 =.. [Pred|Args1],
  102  append(Args1, [Arg1], Args2),
  103  Goal_0 =.. [Pred|Args2].
  104
  105
  106threaded_maplist_2(Mod:Goal_2, Args1, Args2) :-
  107  current_prolog_flag(cpu_count, N),
  108  threaded_maplist_2(N, Mod:Goal_2, Args1, Args2).
  109
  110
  111threaded_maplist_2(N, Mod:Goal_2, Args1, Args2) :-
  112  maplist(make_goal_2(Mod:Goal_2), Args1, Args2, Goals),
  113  concurrent(N, Goals, []).
  114
  115make_goal_2(Mod:Goal_2, Arg1, Arg2, Mod:Goal_0) :-
  116  Goal_2 =.. [Pred|Args1],
  117  append(Args1, [Arg1,Arg2], Args2),
  118  Goal_0 =.. [Pred|Args2]