16
18
39
40:- use_module(library(apply)). 41
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
87
88source_first(Src, Ans) :-
89 source_reset(Src),
90 source_next(Src, Ans).
91
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
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
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
280
294:- use_module(library(debug)). 295
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
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
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
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
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
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
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
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
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
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
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)