1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 3/* Nan.System.Sources 4 Nan.System.Sources/Prolog 1.2.0-beta 5 Answer Sources in Prolog 6 Copyright 2015-2017 Julio P. Di Egidio 7 <mailto:julio@diegidio.name> 8 <http://julio.diegidio.name/Projects/Nan.System.Sources/> 9 10 This file is part of Nan.System.Sources. 11 12 Nan.System.Sources is free software: you can redistribute it and/or modify 13 it under the terms of the GNU General Public License as published by 14 the Free Software Foundation, either version 3 of the License, or 15 (at your option) any later version. 16 17 Nan.System.Sources is distributed in the hope that it will be useful, 18 but WITHOUT ANY WARRANTY; without even the implied warranty of 19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 GNU General Public License for more details. 21 22 You should have received a copy of the GNU General Public License 23 along with Nan.System.Sources. If not, see <http://www.gnu.org/licenses/>. 24*/ 25 26% (SWI-Prolog 7.3.25) 27% Main SWI-Prolog specifics: 28% - Threads 29% - Thread message queues 30% - Global cuts 31 32:- module(sources, 33 [ using_source/4, % @TSol, @GExe, -Src, :GUse 34 using_source_com/4, % +Srcs, :GCom, -Src, :GUse 35 source_create/3, % @TSol, @GExe, -Src 36 source_create_com/5, % +Srcs, @GRst, @GNxt, @Sta0, -Src 37 source_destroy/1, % +Src 38 source_destroy_all/0, % 39 source_reset/1, % +Src 40 source_next/2, % +Src, ?Ans 41 source_next_begin/1, % +Src 42 source_next_end/2, % +Src, ?Ans 43 source_exists/1 % +Src 44 ]). 45 46:- use_module(sources_types). 47:- use_module(sources_system).
70%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 71 72:- use_module(library(apply)). 73 74%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 75% PUBLIC interface: using 76%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Ensures destruction of the source even if goal throws an error.
GExe() is nondet.GUse() is nondet.Example:
?- using_source(I, between(1, 2, I), _S,
( repeat,
source_next(_S, answer(_Det, the(I))),
(_Det == last -> !; true)
)).
I = 1 ;
I = 2.
105:- meta_predicate 106 using_source(, , , ). 107 108using_source(TSol, GExe, Src, GUse) :- 109 setup_call_cleanup( 110 source_create(TSol, GExe, Src), 111 call(GUse), 112 source_destroy(Src) 113 ).
Ensures destruction of the source even if goal throws an error.
GCom(Srcs, Src) is det.GUse() is nondet.Example:
?- [user].
parallel_com(Srcs, Src) :-
GRst = parallel_com__rst,
GNxt = parallel_com__nxt,
source_create_com(Srcs, GRst, GNxt, _, Src).
parallel_com__rst(Srcs, _, _) :-
maplist(source_reset, Srcs).
parallel_com__nxt(Srcs, _, _, Ans) :-
maplist(source_next_begin, Srcs),
foldl(parallel_com__nxt__do, Srcs, [], As),
Ans = answer(more, the(As)).
parallel_com__nxt__do(Src, As0, As) :-
source_next_end(Src, A),
append(As0, [A], As).
^Z
?- using_source(1, sleep(1), _S1,
using_source(2, sleep(1), _S2,
using_source_com([_S1, _S2], parallel_com, _S,
( time(source_next(_S, answer(more, the(Anss))))
)))). % Warm run
% 188 inferences, 0.000 CPU in 1.000 seconds (0% CPU, Infinite Lips)
Anss = [answer(last, the(1)), answer(last, the(2))].
161:- meta_predicate 162 using_source_com(, , , ). 163 164using_source_com(Srcs, GCom, Src, GUse) :- 165 setup_call_cleanup( 166 call(GCom, Srcs, Src), 167 call(GUse), 168 source_destroy(Src) 169 ). 170 171%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 172% PUBLIC interface 173%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
GExe() is nondet.185:- meta_predicate 186 source_create(, , ). 187 188source_create(TSol, GExe, Src) :- 189 source_create_(TSol, GExe, Sid), 190 source_typ_sid(Src, t0, Sid).
GRst(Srcs, Sta0, Sta1) is det.GNxt(Srcs, Sta0, Sta1, Ans) is det.Enforces determinism on GRst and GNxt.
For an example, see using_source_com/4.
209:- meta_predicate 210 source_create_com(, , , , ). 211 212source_create_com(Srcs, GRst, GNxt, Sta0, Src) :- 213 source_create_com_(Srcs, GRst, GNxt, Sta0, Sid), 214 source_typ_sid(Src, t1, Sid).
224source_destroy(Src) :-
225 source_typ_sid(Src, Typ, Sid),
226 source_assert_(Src, Sid),
227 source_destroy_(Typ, Sid).
Fails if no source exists.
235source_destroy_all :-
236 source_destroy_all_.
246source_reset(Src) :-
247 source_typ_sid(Src, Typ, Sid),
248 source_assert_(Src, Sid),
249 source_reset_(Typ, Sid).
260source_next(Src, Ans) :-
261 source_typ_sid(Src, Typ, Sid),
262 source_assert_(Src, Sid),
263 source_next_(Typ, Sid, Ans).
273source_next_begin(Src) :-
274 source_typ_sid(Src, Typ, Sid),
275 source_assert_(Src, Sid),
276 source_next_b_(Typ, Sid).
287source_next_end(Src, Ans) :-
288 source_typ_sid(Src, Typ, Sid),
289 source_assert_(Src, Sid),
290 source_next_e_(Typ, Sid, Ans).
298source_exists(Src) :- 299 source_typ_sid(Src, _, Sid), 300 source_db_exists(Sid). 301 302source_assert_(_, Sid) :- 303 source_db_exists(Sid), !. 304source_assert_(Src, _) :- 305 source_throw(does_not_exist(Src)). 306 307%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 308% PRIVATE implementation: create 309%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 310 311% source_create_com_ (+Srcs, @GRst, @GNxt, @Sta0, -Sid) is det 312 313:- meta_predicate 314 source_create_com_(, , , , ). 315 316source_create_com_(Srcs, GRst, GNxt, Sta0, Sid) :- 317 source_new_sid(t1, Sid), 318 source_call_(Sid, 'CREATE_1', 319 ( copy_term([GRst, GNxt, Sta0], [GRst1, GNxt1, Sta01]), 320 source_db_add(Sid, 'CREATE_1', t1(Srcs, GRst1, GNxt1, Sta01)) 321 )). 322 323% source_create_ (@TSol, @GExe, -Sid) is det 324 325:- meta_predicate 326 source_create_(, , ). 327 328source_create_(TSol, GExe, Sid) :- 329 source_new_sid(t0, Sid), 330 source_call_(Sid, 'CREATE_0', 331 ( source_create__do(Sid, TSol, GExe, Ress) 332 )), source_rethrow(Ress). 333 334:- meta_predicate 335 source_create__do(, , , ). 336 337source_create__do(Sid, TSol, GExe, Ress) :- 338 source_create__pre(Sid, TSol, GExe, [Pid, Tid, GEXEC]), 339 source_create__all(Sid, Pid, Tid, GEXEC, Res1), 340 ( source_has_err(Res1) 341 -> source_create__abort(Sid, Res2), 342 Ress = [Res1, Res2] 343 ; Ress = [Res1] 344 ). 345 346:- meta_predicate 347 source_create__pre(, , , ). 348 349source_create__pre(Sid, TSol, GExe, [Pid, Tid, GEXEC]) :- 350 copy_term([TSol, GExe], [TSol1, GExe1]), 351 atom_concat(Sid, '_p', Pid), 352 atom_concat(Sid, '', Tid), 353 GEXEC = source_exec_(Sid, TSol1, GExe1). 354 355:- meta_predicate 356 source_create__all(, , , , ). 357 358source_create__all(Sid, Pid, Tid, GEXEC, Res) :- 359 source_catch( 360 ( source_db_add(Sid, 'CREATE_0', t0(Pid, Tid)), 361 message_queue_create(_, [alias(Pid)]), 362 thread_create(GEXEC, _, [alias(Tid)]) 363 ), Res). 364 365source_create__abort(Sid, Res) :- 366 source_catch( 367 ( source_destroy_(t0, Sid) 368 ), Res). 369 370%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 371% PRIVATE implementation: destroy 372%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 373 374% source_destroy_all_ () is semidet 375 376source_destroy_all_ :- 377 bagof(Sid, Term^source_db_enum(Sid, Term), Sids), 378 foldl(source_destroy_all__do, Sids, [], Ress), 379 source_rethrow(Ress). 380 381source_destroy_all__do(Sid, Ress0, Ress) :- 382 source_catch( 383 ( source_typ_sid(_, Typ, Sid), 384 source_destroy_(Typ, Sid) 385 ), Res), append(Ress0, [Res], Ress). 386 387% source_destroy_ (+Typ, +Sid) is det 388 389source_destroy_(t1, Sid) :- 390 source_call_(Sid, 'DESTROY_1', 391 ( source_db_del(Sid, 'DESTROY_1') 392 )). 393 394source_destroy_(t0, Sid) :- 395 source_db_get(Sid, 'DESTROY_0', t0(Pid, Tid)), 396 source_call_(Sid, 'DESTROY_0', 397 ( source_destroy__do(Sid, Pid, Tid, Ress) 398 )), source_rethrow(Ress). 399 400source_destroy__do(Sid, Pid, Tid, Ress) :- 401 source_destroy__db(Sid, Res1), 402 source_destroy__queue(Pid, Res2), 403 source_destroy__thread(Sid, Tid, Res3), 404 Ress = [Res1, Res2, Res3]. 405 406source_destroy__db(Sid, Res) :- 407 source_catch( 408 ( source_db_del(Sid, 'DESTROY_0') 409 ), Res). 410 411source_destroy__queue(Qid, Res) :- 412 source_catch( 413 ( message_queue_destroy(Qid) 414 ), Res). 415 416source_destroy__thread(Sid, Tid, Res) :- 417 source_catch( 418 ( ( thread_property(Tid, status(running)) 419 -> source_msg_send_(Sid, 'DESTROY_0', Tid, close) 420 ; true 421 ), thread_join(Tid, _) 422 ), Res). 423 424%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 425% PRIVATE implementation: call 426%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 427 428% source_reset_ (+Typ, +Sid) is det 429 430source_reset_(t1, Sid) :- 431 source_db_get(Sid, 'RESET_1', t1(Srcs, GRst, _, Sta0)), 432 source_call_(Sid, 'RESET_1', 433 ( source_reset__t1(Srcs, GRst, Sta0, Sta1), 434 source_next__t1_state(Sid, 'RESET_1', Sta1) 435 )). 436 437source_reset_(t0, Sid) :- 438 source_db_get(Sid, 'RESET_0', t0(_, Tid)), 439 source_call_(Sid, 'RESET_0', 440 ( source_reset__t0(Sid, 'RESET_0', Tid) 441 )). 442 443% source_next_ (+Typ, +Sid, ?Ans) is semidet 444 445source_next_(t1, Sid, Ans) :- 446 source_db_get(Sid, 'NEXT_1', t1(Srcs, _, GNxt, Sta0)), 447 source_call_(Sid, 'NEXT_1', 448 ( source_next__t1(Srcs, GNxt, Sta0, Sta1, Ans), 449 source_next__t1_state(Sid, 'NEXT_1', Sta1) 450 )). 451 452source_next_(t0, Sid, Ans) :- 453 source_db_get(Sid, 'NEXT_0', t0(Pid, Tid)), 454 source_call_(Sid, 'NEXT_0', 455 ( source_next__t0_b(Sid, 'NEXT_0', Tid), 456 source_next__t0_e(Sid, 'NEXT_0', Pid, Ans) 457 )). 458 459% source_next_b_ (+Typ, +Sid) is det 460 461source_next_b_(t1, Sid) :- 462 source_db_get(Sid, 'NEXT_1_B', _), 463 source_call_(Sid, 'NEXT_1_B', 464 ( true 465 )). 466 467source_next_b_(t0, Sid) :- 468 source_db_get(Sid, 'NEXT_0_B', t0(_, Tid)), 469 source_call_(Sid, 'NEXT_0_B', 470 ( source_next__t0_b(Sid, 'NEXT_0_B', Tid) 471 )). 472 473% source_next_e_ (+Typ, +Sid, ?Ans) is semidet 474 475source_next_e_(t1, Sid, Ans) :- 476 source_db_get(Sid, 'NEXT_1_E', t1(Srcs, _, GNxt, Sta0)), 477 source_call_(Sid, 'NEXT_1_E', 478 ( source_next__t1(Srcs, GNxt, Sta0, Sta1, Ans), 479 source_next__t1_state(Sid, 'NEXT_1_E', Sta1) 480 )). 481 482source_next_e_(t0, Sid, Ans) :- 483 source_db_get(Sid, 'NEXT_0_E', t0(Pid, _)), 484 source_call_(Sid, 'NEXT_0_E', 485 ( source_next__t0_e(Sid, 'NEXT_0_E', Pid, Ans) 486 )). 487 488:- meta_predicate 489 source_reset__t1(, , , ), 490 source_next__t1(, , , , ). 491 492source_reset__t1(Srcs, GRst, Sta0, Sta1) :- 493 call(GRst, Srcs, Sta0, Sta1), !. % NOTE: Enforce determinism! 494 495source_next__t1(Srcs, GNxt, Sta0, Sta1, Ans) :- 496 call(GNxt, Srcs, Sta0, Sta1, Ans_), !, Ans = Ans_. % NOTE: Enforce determinism! 497 498source_next__t1_state(Sid, Cat, Sta1) :- 499 source_db_get(Sid, Cat, t1(Srcs, GRst, GNxt, Sta0)), 500 ( Sta1 \== Sta0 501 -> source_db_del(Sid, Cat), 502 source_db_add(Sid, Cat, t1(Srcs, GRst, GNxt, Sta1)) 503 ; true 504 ). 505 506source_reset__t0(Sid, Cat, Tid) :- 507 source_msg_send_(Sid, Cat, Tid, reset). 508 509source_next__t0_b(Sid, Cat, Tid) :- 510 source_msg_send_(Sid, Cat, Tid, next). 511 512source_next__t0_e(Sid, Cat, Pid, Ans) :- 513 source_msg_recv_(Sid, Cat, Pid, Msg), 514 ( \+ callable(Msg) -> 515 source_throw(invalid_message(Sid, Cat, Msg)) 516 ; Msg = fail -> Ans = answer(fail, no) 517 ; Msg = last(Sol) -> Ans = answer(last, the(Sol)) 518 ; Msg = more(Sol) -> Ans = answer(more, the(Sol)) 519 ; Msg = except(Err) -> 520 source_throw(error_message(Sid, Cat, Err)) 521 ; source_throw(unknown_message(Sid, Cat, Msg)) 522 ). 523 524%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 525% PRIVATE implementation: exec 526%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 527 528% source_exec_ (+Sid, ?TSol, :GExe) is det 529 530:- meta_predicate 531 source_exec_(, , ). 532 533source_exec_(Sid, TSol, GExe) :- 534 source_db_get(Sid, 'EXEC', t0(Pid, Tid)), 535 source_call_(Sid, 'EXEC', 536 ( call_cleanup( 537 source_exec__loop_0(Sid, Pid, Tid, TSol, GExe), 538 exception(Err), 539 source_msg_send_(Sid, 'EXEC', Pid, except(Err)) 540 ) 541 )). 542 543:- meta_predicate 544 source_exec__loop_0(, , , , ), 545 source_exec__loop_1(, , , , ), 546 source_exec__loop_2(, , , ). 547 548source_exec__loop_0(Sid, Pid, Tid, TSol, GExe) :- 549 repeat, 550 source_msg_recv_(Sid, 'EXEC', Tid, Msg), 551 ( \+ callable(Msg) -> 552 source_throw(invalid_message(Sid, 'EXEC', Msg)) 553 ; Msg = reset -> fail 554 ; Msg = close -> ! 555 ; Msg = next -> !, 556 source_exec__loop_1(Sid, Pid, Tid, TSol, GExe) 557 ; source_throw(unknown_message(Sid, 'EXEC', Msg)) 558 ). 559 560source_exec__loop_1(Sid, Pid, Tid, TSol, GExe) :- 561 prolog_current_choice(Loop0), 562 repeat, 563 prolog_current_choice(Loop1), 564 source_exec__loop_2(Sid, Pid, TSol, GExe), 565 source_exec__recv(Sid, Tid, Loop0, Loop1). 566 567source_exec__loop_2(Sid, Pid, TSol, GExe) :- 568 ( call_cleanup(GExe, Det = true), 569 ( Det == true 570 -> source_msg_send_(Sid, 'EXEC', Pid, last(TSol)) 571 ; source_msg_send_(Sid, 'EXEC', Pid, more(TSol)) 572 ) 573 ; repeat, 574 source_msg_send_(Sid, 'EXEC', Pid, fail) 575 ). 576 577source_exec__recv(Sid, Tid, Loop0, Loop1) :- 578 source_msg_recv_(Sid, 'EXEC', Tid, Msg), 579 ( \+ callable(Msg) -> 580 source_throw(invalid_message(Sid, 'EXEC', Msg)) 581 ; Msg = next -> fail 582 ; Msg = close -> prolog_cut_to(Loop0) 583 ; Msg = reset -> prolog_cut_to(Loop1), 584 source_exec__recv(Sid, Tid, Loop0, Loop1) 585 ; source_throw(unknown_message(Sid, 'EXEC', Msg)) 586 ). 587 588%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 589% PRIVATE helpers 590%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 591 592% source_call_ (+Sid, +Cat, :GAct) is det 593 594:- meta_predicate 595 source_call_(, , ). 596 597source_call_(Sid, Cat, GAct) :- 598 setup_call_cleanup( 599 source_log_call(Sid, Cat, start), 600 call(GAct), 601 source_log_call(Sid, Cat, end) 602 ). 603 604% source_msg_send_ (+Sid, +Cat, +Qid, +Msg) is det 605% source_msg_recv_ (+Sid, +Cat, +Qid, -Msg) is det 606 607source_msg_send_(Sid, Cat, Qid, Msg) :- 608 thread_send_message(Qid, Msg), 609 source_log_msg(Sid, Cat, send, Msg). 610 611source_msg_recv_(Sid, Cat, Qid, Msg) :- 612 thread_get_message(Qid, Msg), 613 source_log_msg(Sid, Cat, recv, Msg). 614 615%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Answer Sources
Part of Nan.System.Sources (
nan/system/sources.pl)Module
sources(nan/system/sources.pl) provides the predicates that implement Answer Sources in Prolog.For code docs syntax and meaning see
sources_docs.txt.NOTE: