1/*
    2Answer Sources in Prolog (SWI) - Preview
    3Answer Sources: Extensions
    4Copyright (c) 2015 Julio P. Di Egidio
    5http://julio.diegidio.name/
    6All rights reserved.
    7Answer Sources: Extensions
    8--------------------------
    9Extends answer sources with few utilities and the basic combinators.
   10NOTE:
   11- Predicates in this module do not validate their input.
   12- Access to predicates in this module is not sychronised.
   13TODO:
   14*/
   15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   16
   17%(SWI 7.2.3)
   18
   19/*
   20:- module(nan_kernel_ex,
   21	[	using_source/4,    % (@, @, -, :) is nondet
   22		using_sources/4,   % (:, +, -, :) is nondet
   23		source_first/2,    % (+, ?)       is semidet
   24		source_enum/2,     % (+, ?)       is nondet
   25		append_sources/2,  % (+, -)       is det
   26		compose_sources/2,  % (+, -)       is det
   27
   28                    source_exists/2,      % (+, ?)          is semidet
   29		source_open/5,        % (+, +, @, @, -) is det
   30		source_open/3,        % (@, @, -)       is det
   31		source_close/1,       % (+)             is det
   32		source_reset/1,       % (+)             is det
   33		source_next/2,        % (+, ?)          is semidet
   34		source_next_begin/1,  % (+)             is det
   35		source_next_end/2     % (+, ?)          is semidet
   36	]).
   37:- reexport('Nan.Kernel').
   38*/
   39
   40:- use_module(library(apply)).   41
   42%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   43%!	using_source  (@AnsPatt, @Goal, -Source, :GUsing)  is nondet
   44%!	using_sources (:PComb, +Sources, -Source, :GUsing) is nondet
   45/*
   46?- using_source(s1, sleep(2), _S1,
   47   using_source(s2, sleep(2), _S2,
   48   using_source(s3, sleep(2), _S3,
   49   using_sources(compose_sources, [_S1, _S2, _S3], _S,
   50   (   time(source_next(_S, answer(_, the([A1, A2, A3]))))
   51   ))))).
   52% 546 inferences, 0.000 CPU in 2.000 seconds (0% CPU, Infinite Lips)
   53A1 = answer(last, the(s1)),
   54A2 = answer(last, the(s2)),
   55A3 = answer(last, the(s3)).
   56*/
   57%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   58
   59:- meta_predicate
   60	using_source(+, 0, -, 0).   61
   62using_source(AnsP, G, Src, GU) :-
   63	setup_call_cleanup(
   64		source_open(AnsP, G, Src),
   65		GU,
   66		source_close(Src)
   67	).
   68
   69:- meta_predicate
   70	using_sources(2, +, -, 0).   71
   72using_sources(PC, Srcs, Src, GU) :-
   73	setup_call_cleanup(
   74		call(PC, Srcs, Src),
   75		GU,
   76		source_close(Src)
   77	).
   78
   79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   80%!	source_first (+Source, -Answer) is det
   81%!	source_first (+Source, ?Answer) is semidet
   82%!	
   83%!	Gets the first answer from a given source.
   84%!	Resets the source Source, gets the first answer from it, and
   85%!	unifies the answer with Answer.
   86%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   87
   88source_first(Src, Ans) :-
   89	source_reset(Src),
   90	source_next(Src, Ans).
   91
   92%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   93%!	source_enum (+Source, -Answer) is multi
   94%!	source_enum (+Source, ?Answer) is nondet
   95%!	
   96%!	Enumerates answers from a given source.
   97%!	Gets on backtracking answers from the source Source, and unifies
   98%!	each answer with Answer.
   99%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  100
  101source_enum(Src, Ans) :-
  102	source_next(Src, Ans0),
  103	source_enum__sel(Src, Ans0, Ans).
  104
  105source_enum__sel(_, Ans0, Ans) :-
  106	Ans \= Ans0, !, fail.
  107source_enum__sel(_, Ans0, Ans0).
  108source_enum__sel(Src, _, Ans) :-
  109	source_enum(Src, Ans).
  110
  111%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  112%!	append_sources (+Sources, -Source) is det
  113%!	
  114%!	Append combinator over a list of sources.
  115%!	Creates a new source Source that combines answers from the sources
  116%!	listed in Sources.  Source gets an answer from the first source in
  117%!	Sources that is not closed, defaulting to failure when all the
  118%!	sources are closed (or the list is empty).  Resettings Source
  119%!	resets all Sources (that are not closed).
  120/*
  121?- source_open(I, between(1, 2, I), S1),
  122   source_open(I, between(3, 4, I), S2).
  123S1 = source(t0, 156),
  124S2 = source(t0, 157).
  125?- append_sources([$S1, $S2], S).
  126S = source(t1, 158).
  127?- source_close($S1).
  128true.
  129?- findall(A, source_enum($S, answer(_, the(A))), As).
  130As = [3, 4].
  131?- findall(A, source_enum($S, answer(_, the(A))), As).
  132As = [].
  133?- source_reset($S).
  134true.
  135?- findall(A, source_enum($S, answer(_, the(A))), As).
  136As = [3, 4].
  137?- source_close($S2),
  138   source_reset($S).
  139true.
  140?- findall(A, source_enum($S, answer(_, the(A))), As).
  141As = [].
  142?- source_close($S).
  143true.
  144*/
  145%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  146
  147append_sources(Srcs, Src) :-
  148	PReset = append_s__reset,
  149	PNext = append_s__next,
  150	maplist(append_s__ts0__do, Srcs, Ts0),
  151	source_open(Srcs, Ts0, PReset, PNext, Src).
  152
  153append_s__reset(Srcs, Ts0, Ts1) :-
  154	maplist(append_s__reset__do, Srcs, Ts0, Ts1).
  155
  156append_s__next(Srcs, Ts0, Ts1, Ans) :-
  157	foldl(append_s__next__do, Srcs, Ts0, Ts1, Ans, Ans),
  158	(var(Ans) -> Ans = answer(fail, no) ; true).
  159
  160append_s__ts0__do(_, t).
  161
  162append_s__reset__do(Src, t, t) :-
  163	source_exists(Src, true), !,
  164	source_reset(Src).
  165append_s__reset__do(_, _, f).
  166
  167append_s__next__do(_, T0, T0, Ans, Ans) :-
  168	nonvar(Ans), !.
  169append_s__next__do(Src, t, t, Ans, Ans) :-
  170	source_exists(Src, true), !,
  171	source_next(Src, Ans).
  172append_s__next__do(_, _, f, Ans, Ans).
  173
  174%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  175%!	compose_sources (+Sources, -Source) is det
  176%!	
  177%!	Compose combinator over a list of sources.
  178%!	Creates a new source Source that combines answers from the sources
  179%!	listed in Sources.  In parallel, Source gets one answer from every
  180%!	one of Sources (if any source is closed, defaults to failure), and
  181%!	returns a list of the answers so collected.  Resettings Source
  182%!	resets all Sources (that are not closed).
  183/*
  184?- source_open(I, between(1, 2, I), S1),
  185   source_open(I, between(3, 4, I), S2).
  186S1 = source(t0, 39),
  187S2 = source(t0, 40).
  188?- compose_sources([$S1, $S2], S).
  189S = source(t1, 41).
  190?- source_enum($S, answer(_, the(As))).
  191As = [answer(more, the(1)), answer(more, the(3))] ;
  192As = [answer(last, the(2)), answer(last, the(4))] ;
  193As = [answer(fail, no), answer(fail, no)] ;
  194As = [answer(fail, no), answer(fail, no)] .
  195?- source_reset($S).
  196true.
  197?- source_enum($S, answer(_, the(As))).
  198As = [answer(more, the(1)), answer(more, the(3))] .
  199?- source_reset($S1).
  200true.
  201?- source_enum($S, answer(_, the(As))).
  202As = [answer(more, the(1)), answer(last, the(4))] ;
  203As = [answer(last, the(2)), answer(fail, no)] ;
  204As = [answer(fail, no), answer(fail, no)] .
  205?- source_close($S1), source_reset($S).
  206true.
  207?- source_enum($S, answer(_, the(As))).
  208As = [answer(fail, no), answer(more, the(3))] ;
  209As = [answer(fail, no), answer(last, the(4))] ;
  210As = [answer(fail, no), answer(fail, no)] .
  211?- source_close($S2), source_reset($S).
  212true.
  213?- source_enum($S, answer(_, the(As))).
  214As = [answer(fail, no), answer(fail, no)] .
  215?- source_close($S).
  216true.
  217*/
  218%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  219
  220compose_sources(Srcs, Src) :-
  221	PReset = compose_s__reset,
  222	PNext = compose_s__next,
  223	maplist(compose_s__ts0__do, Srcs, Ts0),
  224	source_open(Srcs, Ts0, PReset, PNext, Src).
  225
  226compose_s__reset(Srcs, Ts0, Ts1) :-
  227	maplist(compose_s__reset__do, Srcs, Ts0, Ts1).
  228
  229compose_s__next(Srcs, Ts0, Ts1, answer(more, the(Anss))) :-
  230	maplist(compose_s__next_b__do, Srcs, Ts0, Ts01),
  231	maplist(compose_s__next_e__do, Srcs, Ts01, Ts1, Anss).
  232
  233compose_s__ts0__do(_, t).
  234
  235compose_s__reset__do(Src, t, t) :-
  236	source_exists(Src, true), !,
  237	source_reset(Src).
  238compose_s__reset__do(_, _, f).
  239
  240compose_s__next_b__do(Src, t, t) :-
  241	source_exists(Src, true), !,
  242	source_next_begin(Src).
  243compose_s__next_b__do(_, _, f).
  244
  245compose_s__next_e__do(Src, t, t, Ans) :-
  246	source_exists(Src, true), !,
  247	source_next_end(Src, Ans).
  248compose_s__next_e__do(_, _, f, answer(fail, no)).
  249
  250/*
  251%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  252Raw
  253 Nan.Kernel.pl
  254%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  255*/
  256/*
  257Answer Sources in Prolog (SWI) - Preview
  258Answer Sources
  259Copyright (c) 2015 Julio P. Di Egidio
  260http://julio.diegidio.name/
  261All rights reserved.
  262Answer Sources
  263--------------
  264Answer sources can be seen as generalized iterators, allowing a given
  265program to control answer production in another. Each answer source
  266works as a separate Prolog interpreter...
  267Multithreading => parallelism...
  268NOTE:
  269- Predicates in this module do not validate their input.
  270- Access to predicates in this module is not sychronised.
  271TODO:
  272- Redesign in terms of a thread-pool.
  273- Rewrite to get rid of the global cuts.
  274- Abstract away cross-cutting concerns:
  275      (validation?), exceptions, logging, database, id/key gen.
  276- Remove logging calls with nan_kernel_debug(false).
  277Main SWI specifics: threads, message queues, global cuts.
  278*/
  279%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  280
  281%(SWI 7.2.3)
  282/*
  283:- module(nan_kernel,
  284	[	source_exists/2,      % (+, ?)          is semidet
  285		source_open/5,        % (+, +, @, @, -) is det
  286		source_open/3,        % (@, @, -)       is det
  287		source_close/1,       % (+)             is det
  288		source_reset/1,       % (+)             is det
  289		source_next/2,        % (+, ?)          is semidet
  290		source_next_begin/1,  % (+)             is det
  291		source_next_end/2     % (+, ?)          is semidet
  292	]).
  293*/
  294:- use_module(library(debug)).  295
  296%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  297%!	source_exists     (+Source, ?Exists)          is semidet
  298%!	source_open (+Sources, +State0, @PReset, @PNext, -Source) is det
  299%!	source_open       (@AnsPatt, @Goal, -Source)  is det
  300%!	source_close      (+Source)                   is det
  301%!	source_reset      (+Source)                   is det
  302%!	source_next       (+Source, ?Answer)          is semidet
  303%!	source_next_begin (+Source)                   is det
  304%!	source_next_end   (+Source, ?Answer)          is semidet
  305%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  306
  307source_exists(Src, Exists) :-
  308	source_sid(Src, Sid),
  309	source_db_exists_(Sid, Exists).
  310
  311:- meta_predicate
  312	source_open(+, +, 3, 4, -).  313
  314source_open(Srcs, T0, PR, PN, Src) :-
  315	source_open_(Srcs, T0, PR, PN, Sid),
  316	source_sid(Src, Sid).
  317
  318:- meta_predicate
  319	source_open(+, 0, -).  320
  321source_open(AnsP, G, Src) :-
  322	source_open_(AnsP, G, Sid),
  323	source_sid(Src, Sid).
  324
  325source_close(Src) :-
  326	source_sid(Src, Sid),
  327	source_close_(Sid).
  328
  329source_reset(Src) :-
  330	source_sid(Src, Sid),
  331	source_reset_(Sid).
  332
  333source_next(Src, Ans) :-
  334	source_sid(Src, Sid),
  335	source_next_(Sid, Ans).
  336
  337source_next_begin(Src) :-
  338	source_sid(Src, Sid),
  339	source_next_begin_(Sid).
  340
  341source_next_end(Src, Ans) :-
  342	source_sid(Src, Sid),
  343	source_next_end_(Sid, Ans).
  344
  345%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  346%	source_open_ (+Srcs, +T0, @PR, @PN, -Sid) is det
  347%	source_open_ (@AnsP, @G, -Sid)            is det
  348%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  349
  350:- meta_predicate
  351	source_open_(+, +, 3, 4, -).  352
  353source_open_(Srcs, T0, PR, PN, Sid) :-
  354	source_new_sid_(t1, Sid),
  355	source_log_act_(
  356		(	copy_term([PR, PN], [PR1, PN1]),
  357			source_db_add_(Sid, t1(Srcs, T0, PR1, PN1))
  358		), Sid, 'OPEN'
  359	).
  360
  361:- meta_predicate
  362	source_open_(+, 0, -).  363
  364source_open_(AnsP, G, Sid) :-
  365	source_new_sid_(t0, Sid),
  366	source_log_act_(
  367		(	source_open__do(Sid, AnsP, G)
  368		), Sid, 'OPEN'
  369	).
  370
  371:- meta_predicate
  372	source_open__do(+, +, 0).  373
  374source_open__do(Sid, AnsP, G) :-
  375	source_open__pre(Sid, AnsP, G, [Pid, Tid, GExec]),
  376	source_open__all(Sid, Pid, Tid, GExec, ErrA1),
  377	(	source_err_(ErrA1, true, _)
  378	->	source_open__abort(Sid, ErrA2)
  379	;	true
  380	),
  381	source_throw_([ErrA1, ErrA2]),
  382	source_log_(Sid, 'OPEN', 'OPENED').
  383
  384:- meta_predicate
  385	source_open__pre(+, +, 0, -).  386
  387source_open__pre(Sid, AnsP, G, [Pid, Tid, GExec]) :-
  388	copy_term([AnsP, G], [AnsP1, G1]),
  389	source_sid_key(Sid, Tid),
  390	atom_concat(Tid, '_p', Pid),
  391	GExec = source_exec(Sid, AnsP1, G1).
  392
  393:- meta_predicate
  394	source_open__all(+, +, +, 0, -).  395
  396source_open__all(Sid, Pid, Tid, GExec, ErrA) :-
  397	source_catch_(
  398		(	source_db_add_(Sid, t0(Pid, Tid)),
  399			message_queue_create(_, [alias(Pid)]),
  400			thread_create(GExec, _, [alias(Tid)])
  401		), ErrA
  402	).
  403
  404source_open__abort(Sid, ErrA) :-
  405	source_catch_(
  406		source_close_(Sid), ErrA
  407	).
  408
  409%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  410%	source_close_ (+Sid) is det
  411%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  412
  413source_close_(Sid) :-
  414	source_sid_type(Sid, t1), !,
  415	source_log_act_(
  416		(	source_db_del_(Sid)
  417		), Sid, 'CLOSE'
  418	).
  419
  420source_close_(Sid) :-
  421	source_db_get_(Sid, t0(Pid, Tid)),
  422	source_log_act_(
  423		(	source_close__do(Sid, Pid, Tid)
  424		), Sid, 'CLOSE'
  425	).
  426
  427source_close__do(Sid, Pid, Tid) :-
  428	source_close__thread(Sid, Tid, StaT, ErrA1),
  429	source_close__queue(Pid, ErrA2),
  430	source_close__db(Sid, ErrA3),
  431	source_throw_([ErrA1, ErrA2, ErrA3]),
  432	source_log_(Sid, 'CLOSE', '~|CLOSED~8+(StaT = ~w)', [StaT]).
  433
  434source_close__thread(Sid, Tid, StaT, ErrA) :-
  435	source_catch_(
  436		(	(	thread_property(Tid, status(running))
  437			->	source_msg_send_(Sid, 'CLOSE', Tid, close)
  438			;	true
  439			), thread_join(Tid, StaT)
  440		), ErrA
  441	).
  442
  443source_close__queue(Qid, ErrA) :-
  444	source_catch_(
  445		message_queue_destroy(Qid), ErrA
  446	).
  447
  448source_close__db(Sid, ErrA) :-
  449	source_catch_(
  450		source_db_del_(Sid), ErrA
  451	).
  452
  453%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  454%	source_reset_      (+Sid)       is det
  455%	source_next_       (+Sid, ?Ans) is semidet
  456%	source_next_begin_ (+Sid)       is det
  457%	source_next_end_   (+Sid, ?Ans) is semidet
  458%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  459
  460source_reset_(Sid) :-
  461	source_sid_type(Sid, t1), !,
  462	source_db_get_(Sid, t1(Srcs, T0, PR, _)),
  463	source_log_act_(
  464		(	source_reset__do(Srcs, PR, T0, T1),
  465			source_next__t1_state(Sid, T1)
  466		), Sid, 'RESET'
  467	).
  468
  469source_reset_(Sid) :-
  470	source_db_get_(Sid, t0(_, Tid)),
  471	source_log_act_(
  472		(	source_reset__do(Sid, 'RESET', Tid)
  473		), Sid, 'RESET'
  474	).
  475
  476source_next_(Sid, Ans) :-
  477	source_sid_type(Sid, t1), !,
  478	source_db_get_(Sid, t1(Srcs, T0, _, PN)),
  479	source_log_act_(
  480		(	source_next__do(Srcs, PN, T0, T1, Ans),
  481			source_next__t1_state(Sid, T1)
  482		), Sid, 'NEXT'
  483	).
  484
  485source_next_(Sid, Ans) :-
  486	source_db_get_(Sid, t0(Pid, Tid)),
  487	source_log_act_(
  488		(	source_next_begin__do(Sid, 'NEXT', Tid),
  489			source_next_end__do(Sid, 'NEXT', Pid, Ans)
  490		), Sid, 'NEXT'
  491	).
  492
  493source_next_begin_(Sid) :-
  494	source_sid_type(Sid, t1), !,
  495	source_log_act_(
  496		(	true
  497		), Sid, 'NEXT_B'
  498	).
  499
  500source_next_begin_(Sid) :-
  501	source_db_get_(Sid, t0(_, Tid)),
  502	source_log_act_(
  503		(	source_next_begin__do(Sid, 'NEXT_B', Tid)
  504		), Sid, 'NEXT_B'
  505	).
  506
  507source_next_end_(Sid, Ans) :-
  508	source_sid_type(Sid, t1), !,
  509	source_db_get_(Sid, t1(Srcs, T0, _, PN)),
  510	source_log_act_(
  511		(	source_next__do(Srcs, PN, T0, T1, Ans),
  512			source_next__t1_state(Sid, T1)
  513		), Sid, 'NEXT_E'
  514	).
  515
  516source_next_end_(Sid, Ans) :-
  517	source_db_get_(Sid, t0(Pid, _)),
  518	source_log_act_(
  519		(	source_next_end__do(Sid, 'NEXT_E', Pid, Ans)
  520		), Sid, 'NEXT_E'
  521	).
  522
  523source_next__t1_state(Sid, T1) :-
  524	source_db_get_(Sid, t1(Srcs, T0, PR, PN)),
  525	(	T1 \== T0
  526	->	source_db_del_(Sid),
  527		source_db_add_(Sid, t1(Srcs, T1, PR, PN))
  528	;	true
  529	).
  530
  531:- meta_predicate
  532	source_reset__do(+, 3, +, -).  533
  534source_reset__do(Srcs, PR, T0, T1) :-
  535	call(PR, Srcs, T0, T1), !.
  536
  537:- meta_predicate
  538	source_next__do(+, 4, +, -, ?).  539
  540source_next__do(Srcs, PN, T0, T1, Ans) :-
  541	call(PN, Srcs, T0, T1, Ans1), !, Ans = Ans1.
  542
  543source_reset__do(Sid, Act, Tid) :-
  544	source_msg_send_(Sid, Act, Tid, reset).
  545
  546source_next_begin__do(Sid, Act, Tid) :-
  547	source_msg_send_(Sid, Act, Tid, next).
  548
  549source_next_end__do(Sid, Act, Pid, Ans) :-
  550	source_msg_recv_(Sid, Act, Pid, Msg),
  551	(	Msg = fail        -> Ans = answer(fail, no)
  552	;	Msg = last(AnsP)  -> Ans = answer(last, the(AnsP))
  553	;	Msg = more(AnsP)  -> Ans = answer(more, the(AnsP))
  554	;	Msg = except(Err) -> throw(Err)
  555	;	throw(source_error(unknown_message(data, Sid, Msg), _))
  556	).
  557
  558%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  559%!	source_exec (+Sid, ?AnsP, :G) is det
  560%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  561
  562:- public
  563	source_exec/3.  564
  565:- meta_predicate
  566	source_exec(+, ?, 0).  567
  568source_exec(Sid, AnsP, G) :-
  569	source_db_get_(Sid, t0(Pid, Tid)),
  570	source_log_act_(
  571		call_cleanup(
  572			source_exec__loop_0(Sid, Pid, Tid, AnsP, G),
  573			exception(Err),
  574			source_msg_send_(Sid, 'EXEC', Pid, except(Err))
  575		), Sid, 'EXEC'
  576	).
  577
  578:- meta_predicate
  579	source_exec__loop_0(+, +, +, ?, 0).  580
  581source_exec__loop_0(Sid, Pid, Tid, AnsP, G) :-
  582	repeat,
  583	source_msg_recv_(Sid, 'EXEC', Tid, Msg),
  584	(	Msg == reset -> fail
  585	;	Msg == close -> !
  586	;	Msg == next  -> !,
  587			source_exec__loop_1(Sid, Pid, Tid, AnsP, G)
  588	;	throw(source_error(unknown_message(ctrl, Sid, Msg), _))
  589	).
  590
  591:- meta_predicate
  592	source_exec__loop_1(+, +, +, ?, 0).  593
  594source_exec__loop_1(Sid, Pid, Tid, AnsP, G) :-
  595	prolog_current_choice(Loop1),
  596	repeat,
  597	prolog_current_choice(Loop2),
  598	source_exec__loop_2(Sid, Pid, AnsP, G),
  599	source_exec__recv(Sid, Tid, Loop1, Loop2).
  600
  601:- meta_predicate
  602	source_exec__loop_2(+, +, ?, 0).  603
  604source_exec__loop_2(Sid, Pid, AnsP, G) :-
  605	(	call_cleanup(G, Det = true),
  606		(	Det == true
  607		->	source_msg_send_(Sid, 'EXEC', Pid, last(AnsP))
  608		;	source_msg_send_(Sid, 'EXEC', Pid, more(AnsP))
  609		),
  610		source_log_(Sid, 'EXEC', '~|CALLED~8+(Det = ~w)', [Det])
  611	;	repeat,
  612		source_msg_send_(Sid, 'EXEC', Pid, fail)
  613	).
  614
  615source_exec__recv(Sid, Tid, Loop1, Loop2) :-
  616	source_msg_recv_(Sid, 'EXEC', Tid, Msg),
  617	(	Msg == next  -> fail
  618	;	Msg == close -> prolog_cut_to(Loop1)
  619	;	Msg == reset -> prolog_cut_to(Loop2),
  620			source_exec__recv(Sid, Tid, Loop1, Loop2)
  621	;	throw(source_error(unknown_message(ctrl, Sid, Msg), _))
  622	).
  623
  624%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  625%	source_msg_send_ (+Sid, +Act, +Qid, +Msg) is det
  626%	source_msg_recv_ (+Sid, +Act, +Qid, -Msg) is det
  627%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  628
  629source_msg_send_(Sid, Act, Qid, Msg) :-
  630	thread_send_message(Qid, Msg),
  631	source_log_msg_(Sid, Act, '>>', Msg).
  632
  633source_msg_recv_(Sid, Act, Qid, Msg) :-
  634	thread_get_message(Qid, Msg),
  635	source_log_msg_(Sid, Act, '<<', Msg).
  636
  637%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  638%	source_catch_ (:GAct, -ErrA)         is det
  639%	source_throw_ (+ErrAs)               is det
  640%	source_err_   (+ErrA, -HasErr, -Err) is det
  641%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  642
  643:- meta_predicate
  644	source_catch_(0, -).  645
  646source_catch_(GAct, ErrA) :-
  647	catch(
  648		(	call(GAct),
  649			HasErr = false
  650		),
  651		Err, HasErr = true
  652	),
  653	source_err_(ErrA, HasErr, Err).
  654
  655source_throw_(ErrAs) :-
  656	source_throw___loop(ErrAs, Errs),
  657	(	Errs = []    -> true
  658	;	Errs = [Err] -> throw(Err)
  659	;	throw(source_error(many_errors, Errs))
  660	).
  661
  662source_throw___loop([], []).
  663source_throw___loop([ErrA| ErrAs], Errs) :-
  664	source_err_(ErrA, HasErr, Err),
  665	(	HasErr == true
  666	->	Errs = [Err| Errs1]
  667	;	Errs = Errs1
  668	),
  669	source_throw___loop(ErrAs, Errs1).
  670
  671source_err_(ErrA, HasErr, Err) :-
  672	ErrA = err(HasErr, Err).
  673
  674%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  675%	source_log_act_ (:GAct, +Sid, +Act)         is det
  676%	source_log_msg_ (+Sid, +Act, +Dir, +QMsg)   is det
  677%	source_log_     (+Sid, +Act, +Msg1)         is det
  678%	source_log_     (+Sid, +Act, +Fmt1, +Args1) is det
  679%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  680
  681:- meta_predicate
  682	source_log_act_(0, +, +).  683
  684source_log_act_(GAct, Sid, Act) :-
  685	setup_call_cleanup(
  686		source_log_(Sid, Act, 'Start...'),
  687		GAct,
  688		source_log_(Sid, Act, 'Done.')
  689	).
  690
  691source_log_msg_(Sid, Act, Dir, QMsg) :-
  692	(	debugging(nan_kernel)
  693	->	(	Act == 'EXEC'
  694		->	(Dir == '>>' -> Typ = data ; Typ = ctrl)
  695		;	(Dir == '>>' -> Typ = ctrl ; Typ = data)
  696		),
  697		Args = [Dir, Typ, QMsg],
  698		source_log__do(Sid, Act, '~|--~a--~8+(~a) ~w', Args)
  699	;	true
  700	).
  701
  702source_log_(Sid, Act, Msg1) :-
  703	(	debugging(nan_kernel)
  704	->	source_log__do(Sid, Act, Msg1, [])
  705	;	true
  706	).
  707
  708source_log_(Sid, Act, Fmt1, Args1) :-
  709	(	debugging(nan_kernel)
  710	->	source_log__do(Sid, Act, Fmt1, Args1)
  711	;	true
  712	).
  713
  714source_log__do(Sid, Act, Fmt1, Args1) :-
  715	get_time(Tm),
  716	Tm1 is floor(float_fractional_part(Tm / 100) * 100_000),
  717	format(atom(TM), '~3d', [Tm1]),
  718	Term = nan_kernel__source(Sid, Act, TM, Fmt1, Args1),
  719	print_message(informational, Term).
  720
  721:- multifile
  722	prolog:message//1.  723
  724prolog:message(nan_kernel__source(Sid, Act, TM, Fmt1, Args1)) -->
  725	{	source_sid_sel_(_, TNum, Id, Sid),
  726		format(atom(Msg1), Fmt1, Args1),
  727		Args = [TM, TNum, Id, Act, Msg1]
  728	},	['~a : source(t~d, ~d) : ~|~w~6+ : ~a'-Args].
  729
  730%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  731%	source_db_exists_ (+Sid, ?Exists) is semidet
  732%!	source_db_gen     (?Sid, ?Term)   is nondet
  733%	source_db_add_    (+Sid, +Term)   is det
  734%	source_db_get_    (+Sid, -Term)   is det
  735%	source_db_del_    (+Sid)          is det
  736%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  737
  738source_db_exists_(Sid, Exists) :-
  739	source_sid_key(Sid, Key),
  740	(	recorded(Key, _)
  741	->	Exists = true
  742	;	Exists = false
  743	).
  744
  745:- public
  746	source_db_gen/2.  747
  748source_db_gen(Sid, Term) :-
  749	recorded(Key, Term),
  750	source_sid_key(Sid, Key).
  751
  752source_db_add_(Sid, Term) :-
  753	source_db__val(has_not, Sid, Key),
  754	recordz(Key, Term).
  755
  756source_db_get_(Sid, Term) :-
  757	source_db__val(has, Sid, _, Term, _).
  758
  759source_db_del_(Sid) :-
  760	source_db__val(has, Sid, _, _, Ref),
  761	erase(Ref).
  762
  763source_db__val(has_not, Sid, Key) :-
  764	source_sid_key(Sid, Key),
  765	(	\+ recorded(Key, _)
  766	->	true
  767	;	throw(source_error(record_exists_already(Sid, Key), _))
  768	).
  769source_db__val(has, Sid, Key, Term, Ref) :-
  770	source_sid_key(Sid, Key),
  771	(	recorded(Key, Term, Ref)
  772	->	true
  773	;	throw(source_error(record_does_not_exist(Sid, Key), _))
  774	).
  775
  776%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  777%!	source_sid      (+Source, -Sid)           is semidet
  778%!	source_sid      (-Source, +Sid)           is det
  779%!	source_sid_type (+Sid, -Type)             is det
  780%!	source_sid_key  (+Sid, -Key)              is det
  781%!	source_sid_key  (-Sid, +Key)              is det
  782%	source_sid_sel_ (+Type, +TNum, +Id, -Sid) is det
  783%	source_sid_sel_ (-Type, -TNum, -Id, +Sid) is det
  784%	source_new_sid_ (+Type, -Sid)             is det
  785%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  786
  787:- public
  788	source_sid/2,
  789	source_sid_key/2.  790
  791source_sid(source(Type, Id), Sid) :-
  792	source_sid__do(Type, _, Id, Sid).
  793
  794source_sid_type(Sid, Type) :-
  795	source_sid__do(Type, _, _, Sid).
  796
  797source_sid_key(Sid, Key) :-
  798	var(Key), !,
  799	source_sid__do(_, TNum, Id, Sid),
  800	ACs = [nan_kernel__source__t, TNum, '__', Id],
  801	atomic_list_concat(ACs, Key).
  802source_sid_key(Sid, Key) :-
  803	atom_concat(nan_kernel__source__t, K1, Key),
  804	sub_atom(K1, 0, 1, _, TVal),
  805	sub_atom(K1, 3, _, 0, IdVal),
  806	atom_number(TVal, TNum),
  807	atom_number(IdVal, Id),
  808	source_sid__num(type, TNum),
  809	source_sid__num(id, Id),
  810	source_sid_sel_(_, TNum, Id, Sid).
  811
  812source_sid__do(Type, TNum, Id, Sid) :-
  813	source_sid_sel_(Type, TNum, Id, Sid),
  814	source_sid__num(type, TNum),
  815	source_sid__num(id, Id).
  816
  817source_sid_sel_(t1, 1, Id, t1(Id)) :- !.
  818source_sid_sel_(t0, 0, Id, t0(Id)).
  819
  820source_sid__num(type, Num) :-
  821	integer(Num), Num >= 0, Num =< 1.
  822source_sid__num(id, Num) :-
  823	integer(Num), Num >= 0.
  824
  825source_new_sid_(Type, Sid) :-
  826	flag(nan_kernel__source, Id, Id + 1),
  827	succ(Id, Id1),
  828	source_sid_sel_(Type, _, Id1, Sid).
  829
  830%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  831
  832
  833:- use_module(library(prolog_server)).  834:- prolog_server(4023,[allow(_)]).  835
  836:- use_module(library(heaps)).  837
  838nop(_).
  839wdbg(P):-format(user_error,'~NWDBG: ~q.~n',[P]),
  840	flush_output(user_error).
  841
  842e_call(E,Goal) :-
  843        engine_foc(E,Goal),
  844        setup_call_cleanup(
  845           engine_post(E,call(Goal)),
  846           engine_next(E, Goal),
  847            wdbg(engine_done(E,Goal))).
  848
  849engine_foc(E,Goal):-
  850   engine_post(E,call(Goal)),
  851   engine_next(E, Goal).
  852
  853engine_foc(E,_Goal):-
  854	catch(current_engine(E),_,fail),!.
  855engine_foc(E,Goal):-
  856        engine_create(Goal, engine_do_all , E).
  857
  858engine_do_all:-!,engine_fetch(Do),Do.
  859engine_do_all:-
  860        repeat,
  861	(engine_fetch(call(Goal))->
  862        call_cleanup(call(Goal),fail)).
  863
  864
  865
  866e_findall(Templ, Goal, List) :-
  867        setup_call_cleanup(
  868            engine_create(Templ, Goal, E),
  869            e_get_answers(E, List),
  870            engine_destroy(E)).
  871
  872e_get_answers(E, [H|T]) :-
  873        engine_next(E, H), !,
  874        get_answers(E, T).
  875e_get_answers(_, []).
  876
  877
  878
  879
  880create_heap(E) :-
  881        empty_heap(H),
  882        engine_create(_, update_heap(H), E).
  883
  884update_heap(H) :-
  885        engine_fetch(Command),
  886        (   update_heap(Command, Reply, H, H1)
  887        ->  true
  888        ;   H1 = H,
  889            Reply = false
  890        ),
  891        engine_yield(Reply),
  892        update_heap(H1).
  893
  894update_heap(add(Priority, Key), true, H0, H) :-
  895        add_to_heap(H0, Priority, Key, H).
  896update_heap(get(Priority, Key), Priority-Key, H0, H) :-
  897        get_from_heap(H0, Priority, Key, H).
  898
  899heap_add(Priority, Key, E) :-
  900        engine_post(E, add(Priority, Key), true).
  901
  902heap_get(Priority, Key, E) :-
  903        engine_post(E, get(Priority, Key), Priority-Key).
  904
  905:- meta_predicate merge(?,0, ?,0, -).  906
  907merge(T1,G1, T2,G2, A) :-
  908        engine_create(A, merge(T1,G1, T2,G2), E),
  909        repeat,
  910            (   engine_next(E, A)
  911            ->  true
  912            ;   !, fail
  913            ).
  914
  915merge(T1,G1, T2,G2) :-
  916        engine_create(T1, G1, E1),
  917        engine_create(T2, G2, E2),
  918        (   engine_next(E1, S1)
  919        ->  (   engine_next(E2, S2)
  920            ->  order_solutions(S1, S2, E1, E2)
  921            ;   yield_remaining(S1, E1)
  922            )
  923        ;   engine_next(E2, S2),
  924            yield_remaining(S2, E2)
  925        ).
  926
  927order_solutions(S1, S2, E1, E2) :- !,
  928        (   S1 @=< S2
  929        ->  engine_yield(S1),
  930            (   engine_next(E1, S11)
  931            ->  order_solutions(S11, S2, E1, E2)
  932            ;   yield_remaining(S2, E2)
  933            )
  934        ;   engine_yield(S2),
  935            (   engine_next(E2, S21)
  936            ->  order_solutions(S1, S21, E1, E2)
  937            ;   yield_remaining(S1, E1)
  938            )
  939        ).
  940
  941yield_remaining(S, E) :-
  942        engine_yield(S),
  943        engine_next(E, S1),
  944        yield_remaining(S1, E).
  945
  946
  947
  948:- meta_predicate merge_answers(?,0, ?,0, -).  949
  950merge_answers(T1,G1, T2,G2, A) :-
  951        findall(T1, G1, L1),
  952        findall(T2, G2, L2),
  953        ord_union(L1, L2, Ordered),
  954        member(A, Ordered)