37
38:- module('$tabling',
39 [ (table)/1, 40 untable/1, 41
42 (tnot)/1, 43 not_exists/1, 44 undefined/0,
45 answer_count_restraint/0,
46 radial_restraint/0,
47
48 current_table/2, 49 abolish_all_tables/0,
50 abolish_private_tables/0,
51 abolish_shared_tables/0,
52 abolish_table_subgoals/1, 53 abolish_module_tables/1, 54 abolish_nonincremental_tables/0,
55 abolish_nonincremental_tables/1, 56 abolish_monotonic_tables/0,
57
58 start_tabling/3, 59 start_subsumptive_tabling/3, 60 start_abstract_tabling/3, 61 start_moded_tabling/5, 62 63
64 '$tbl_answer'/4, 65
66 '$wrap_tabled'/2, 67 '$moded_wrap_tabled'/5, 68 '$wfs_call'/2, 69
70 '$set_table_wrappers'/1, 71 '$start_monotonic'/2 72 ]). 73
74:- meta_predicate
75 table(:),
76 untable(:),
77 tnot(0),
78 not_exists(0),
79 tabled_call(0),
80 start_tabling(+, +, 0),
81 start_abstract_tabling(+, +, 0),
82 start_moded_tabling(+, +, 0, +, ?),
83 current_table(:, -),
84 abolish_table_subgoals(:),
85 '$wfs_call'(0, :). 86
96
99goal_expansion(tdebug(Topic, Fmt, Args), Expansion) :-
100 ( current_prolog_flag(prolog_debug, true)
101 -> Expansion = debug(tabling(Topic), Fmt, Args)
102 ; Expansion = true
103 ).
104goal_expansion(tdebug(Goal), Expansion) :-
105 ( current_prolog_flag(prolog_debug, true)
106 -> Expansion = ( debugging(tabling(_))
107 -> ( Goal
108 -> true
109 ; print_message(error,
110 format('goal_failed: ~q', [Goal]))
111 )
112 ; true
113 )
114 ; Expansion = true
115 ).
116
117:- if(current_prolog_flag(prolog_debug, true)). 118:- autoload(library(debug), [debug/3]). 119
120wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
121 !,
122 '$tbl_wkl_table'(WorkList, ATrie),
123 trie_goal(ATrie, Goal, Skeleton).
124wl_goal(WorkList, Goal, Skeleton) :-
125 '$tbl_wkl_table'(WorkList, ATrie),
126 trie_goal(ATrie, Goal, Skeleton).
127
128trie_goal(ATrie, Goal, Skeleton) :-
129 '$tbl_table_status'(ATrie, _Status, M:Variant, Skeleton),
130 ( M:'$table_mode'(Goal0, Variant, _Moded)
131 -> true
132 ; Goal0 = Variant 133 ),
134 unqualify_goal(M:Goal0, user, Goal).
135
136delay_goals(List, Goal) :-
137 delay_goals(List, user, Goal).
138
139user_goal(Goal, UGoal) :-
140 unqualify_goal(Goal, user, UGoal).
141
142:- multifile
143 prolog:portray/1. 144
145user:portray(ATrie) :-
146 '$is_answer_trie'(ATrie, _),
147 trie_goal(ATrie, Goal, _Skeleton),
148 ( '$idg_falsecount'(ATrie, FalseCount)
149 -> ( '$idg_forced'(ATrie)
150 -> format('~q [fc=~d/F] for ~p', [ATrie, FalseCount, Goal])
151 ; format('~q [fc=~d] for ~p', [ATrie, FalseCount, Goal])
152 )
153 ; format('~q for ~p', [ATrie, Goal])
154 ).
155user:portray(Cont) :-
156 compound(Cont),
157 compound_name_arguments(Cont, '$cont$', [_Context, Clause, PC | Args]),
158 clause_property(Clause, file(File)),
159 file_base_name(File, Base),
160 clause_property(Clause, line_count(Line)),
161 clause_property(Clause, predicate(PI)),
162 format('~q at ~w:~d @PC=~w, ~p', [PI, Base, Line, PC, Args]).
163
164:- endif. 165
188
189table(M:PIList) :-
190 setup_call_cleanup(
191 '$set_source_module'(OldModule, M),
192 expand_term((:- table(PIList)), Clauses),
193 '$set_source_module'(OldModule)),
194 dyn_tabling_list(Clauses, M).
195
196dyn_tabling_list([], _).
197dyn_tabling_list([H|T], M) :-
198 dyn_tabling(H, M),
199 dyn_tabling_list(T, M).
200
201dyn_tabling(M:Clause, _) :-
202 !,
203 dyn_tabling(Clause, M).
204dyn_tabling((:- multifile(PI)), M) :-
205 !,
206 multifile(M:PI),
207 dynamic(M:PI).
208dyn_tabling(:- initialization(Wrap, now), M) :-
209 !,
210 M:Wrap.
211dyn_tabling('$tabled'(Head, TMode), M) :-
212 ( clause(M:'$tabled'(Head, OMode), true, Ref),
213 ( OMode \== TMode
214 -> erase(Ref),
215 fail
216 ; true
217 )
218 -> true
219 ; assertz(M:'$tabled'(Head, TMode))
220 ).
221dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
222 ( clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
223 -> ( t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
224 -> true
225 ; erase(Ref),
226 assertz(M:'$table_mode'(Head, Variant, Moded))
227 )
228 ; assertz(M:'$table_mode'(Head, Variant, Moded))
229 ).
230dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
231 ( clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
232 -> ( t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
233 -> true
234 ; erase(Ref),
235 assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
236 )
237 ; assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
238 ).
239
248
249untable(M:PIList) :-
250 untable(PIList, M).
251
252untable(Var, _) :-
253 var(Var),
254 !,
255 '$instantiation_error'(Var).
256untable(M:Spec, _) :-
257 !,
258 '$must_be'(atom, M),
259 untable(Spec, M).
260untable((A,B), M) :-
261 !,
262 untable(A, M),
263 untable(B, M).
264untable(Name//Arity, M) :-
265 atom(Name), integer(Arity), Arity >= 0,
266 !,
267 Arity1 is Arity+2,
268 untable(Name/Arity1, M).
269untable(Name/Arity, M) :-
270 !,
271 functor(Head, Name, Arity),
272 ( '$get_predicate_attribute'(M:Head, tabled, 1)
273 -> abolish_table_subgoals(M:Head),
274 dynamic(M:'$tabled'/2),
275 dynamic(M:'$table_mode'/3),
276 retractall(M:'$tabled'(Head, _TMode)),
277 retractall(M:'$table_mode'(Head, _Variant, _Moded)),
278 unwrap_predicate(M:Name/Arity, table),
279 '$set_predicate_attribute'(M:Head, tabled, false),
280 '$set_predicate_attribute'(M:Head, opaque, false),
281 '$set_predicate_attribute'(M:Head, incremental, false),
282 '$set_predicate_attribute'(M:Head, monotonic, false),
283 '$set_predicate_attribute'(M:Head, lazy, false)
284 ; true
285 ).
286untable(Head, M) :-
287 callable(Head),
288 !,
289 functor(Head, Name, Arity),
290 untable(Name/Arity, M).
291untable(TableSpec, _) :-
292 '$type_error'(table_desclaration, TableSpec).
293
294untable_reconsult(PI) :-
295 print_message(informational, untable(PI)),
296 untable(PI).
297
298:- initialization
299 prolog_listen(untable, untable_reconsult). 300
301
302'$wrap_tabled'(Head, Options) :-
303 get_dict(mode, Options, subsumptive),
304 !,
305 set_pattributes(Head, Options),
306 '$wrap_predicate'(Head, table, Closure, Wrapped,
307 start_subsumptive_tabling(Closure, Head, Wrapped)).
308'$wrap_tabled'(Head, Options) :-
309 get_dict(subgoal_abstract, Options, _Abstract),
310 !,
311 set_pattributes(Head, Options),
312 '$wrap_predicate'(Head, table, Closure, Wrapped,
313 start_abstract_tabling(Closure, Head, Wrapped)).
314'$wrap_tabled'(Head, Options) :-
315 !,
316 set_pattributes(Head, Options),
317 '$wrap_predicate'(Head, table, Closure, Wrapped,
318 start_tabling(Closure, Head, Wrapped)).
319
324
325set_pattributes(Head, Options) :-
326 '$set_predicate_attribute'(Head, tabled, true),
327 ( tabled_attribute(Attr),
328 get_dict(Attr, Options, Value),
329 '$set_predicate_attribute'(Head, Attr, Value),
330 fail
331 ; current_prolog_flag(table_monotonic, lazy),
332 '$set_predicate_attribute'(Head, lazy, true),
333 fail
334 ; true
335 ).
336
337tabled_attribute(incremental).
338tabled_attribute(dynamic).
339tabled_attribute(tshared).
340tabled_attribute(max_answers).
341tabled_attribute(subgoal_abstract).
342tabled_attribute(answer_abstract).
343tabled_attribute(monotonic).
344tabled_attribute(opaque).
345tabled_attribute(lazy).
346
360
361start_tabling(Closure, Wrapper, Worker) :-
362 '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton, IsMono),
363 ( IsMono == true
364 -> shift(dependency(Skeleton, Trie, Mono)),
365 ( Mono == true
366 -> tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
367 ; start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
368 )
369 ; start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
370 ).
371
372start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
373 tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
374 ( Status == complete
375 -> trie_gen_compiled(Trie, Skeleton)
376 ; functor(Status, fresh, 2)
377 -> catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
378 deadlock,
379 restart_tabling(Closure, Wrapper, Worker))
380 ; Status == invalid
381 -> reeval(Trie, Wrapper, Skeleton)
382 ; 383 shift_for_copy(call_info(Skeleton, Status))
384 ).
385
386create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
387 tdebug(Fresh = fresh(SCC, WorkList)),
388 tdebug(wl_goal(WorkList, Goal, _)),
389 tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
390 setup_call_catcher_cleanup(
391 '$idg_set_current'(OldCurrent, Trie),
392 run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
393 Catcher,
394 finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
395 tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
396 done_leader(LStatus, Fresh, Skeleton, Clause).
397
405
406restart_tabling(Closure, Wrapper, Worker) :-
407 tdebug(user_goal(Wrapper, Goal)),
408 tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
409 sleep(0.000001),
410 start_tabling(Closure, Wrapper, Worker).
411
412restart_abstract_tabling(Closure, Wrapper, Worker) :-
413 tdebug(user_goal(Wrapper, Goal)),
414 tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
415 sleep(0.000001),
416 start_abstract_tabling(Closure, Wrapper, Worker).
417
427
428start_subsumptive_tabling(Closure, Wrapper, Worker) :-
429 ( '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
430 -> ( Status == complete
431 -> trie_gen_compiled(Trie, Skeleton)
432 ; Status == invalid
433 -> reeval(Trie, Wrapper, Skeleton),
434 trie_gen_compiled(Trie, Skeleton)
435 ; shift_for_copy(call_info(Skeleton, Status))
436 )
437 ; more_general_table(Wrapper, ATrie),
438 '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
439 -> '$tbl_answer_update_dl'(ATrie, Skeleton) 440 ; more_general_table(Wrapper, ATrie),
441 '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
442 -> ( Status == invalid
443 -> reeval(ATrie, GenWrapper, GenSkeleton),
444 Wrapper = GenWrapper,
445 '$tbl_answer_update_dl'(ATrie, GenSkeleton)
446 ; wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
447 shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
448 unify_subsumptive(Skeleton, GenSkeleton)
449 )
450 ; start_tabling(Closure, Wrapper, Worker)
451 ).
452
457
458wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
459 copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
460 tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
461 [GenSkeleton+Skeleton]).
462
463unify_subsumptive(X,X).
464
475
476start_abstract_tabling(Closure, Wrapper, Worker) :-
477 '$tbl_abstract_table'(Closure, Wrapper, Trie, _Abstract, Status, Skeleton),
478 tdebug(abstract, 'Wrapper=~p, Worker=~p, Skel=~p',
479 [Wrapper, Worker, Skeleton]),
480 ( is_most_general_term(Skeleton) 481 -> start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
482 ; Status == complete
483 -> '$tbl_answer_update_dl'(Trie, Skeleton)
484 ; functor(Status, fresh, 2)
485 -> '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
486 abstract_worker(Worker, GenWrapper, GenWorker),
487 catch(create_abstract_table(Trie, Status, Skeleton, GenSkeleton, GenWrapper,
488 GenWorker),
489 deadlock,
490 restart_abstract_tabling(Closure, Wrapper, Worker))
491 ; Status == invalid
492 -> '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
493 reeval(ATrie, GenWrapper, GenSkeleton),
494 Wrapper = GenWrapper,
495 '$tbl_answer_update_dl'(ATrie, Skeleton)
496 ; shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
497 unify_subsumptive(Skeleton, GenSkeleton)
498 ).
499
500create_abstract_table(Trie, Fresh, Skeleton, GenSkeleton, Wrapper, Worker) :-
501 tdebug(Fresh = fresh(SCC, WorkList)),
502 tdebug(wl_goal(WorkList, Goal, _)),
503 tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
504 setup_call_catcher_cleanup(
505 '$idg_set_current'(OldCurrent, Trie),
506 run_leader(GenSkeleton, Worker, Fresh, LStatus, _Clause),
507 Catcher,
508 finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
509 tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
510 Skeleton = GenSkeleton,
511 done_abstract_leader(LStatus, Fresh, GenSkeleton, Trie).
512
513abstract_worker(_:call(Term), _M:GenWrapper, call(GenTerm)) :-
514 functor(Term, Closure, _),
515 GenWrapper =.. [_|Args],
516 GenTerm =.. [Closure|Args].
517
518:- '$hide'((done_abstract_leader/4)). 519
520done_abstract_leader(complete, _Fresh, Skeleton, Trie) :-
521 !,
522 '$tbl_answer_update_dl'(Trie, Skeleton).
523done_abstract_leader(final, fresh(SCC, _Worklist), Skeleton, Trie) :-
524 !,
525 '$tbl_free_component'(SCC),
526 '$tbl_answer_update_dl'(Trie, Skeleton).
527done_abstract_leader(_,_,_,_).
528
535
536:- '$hide'((done_leader/4, finished_leader/4)). 537
538done_leader(complete, _Fresh, Skeleton, Clause) :-
539 !,
540 trie_gen_compiled(Clause, Skeleton).
541done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
542 !,
543 '$tbl_free_component'(SCC),
544 trie_gen_compiled(Clause, Skeleton).
545done_leader(_,_,_,_).
546
547finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
548 '$idg_set_current'(OldCurrent),
549 ( Catcher == exit
550 -> true
551 ; Catcher == fail
552 -> true
553 ; Catcher = exception(_)
554 -> Fresh = fresh(SCC, _),
555 '$tbl_table_discard_all'(SCC)
556 ; print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
557 ).
558
571
572run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
573 tdebug(wl_goal(Worklist, Goal, Skeleton)),
574 tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
575 activate(Skeleton, Worker, Worklist),
576 tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
577 completion(SCC, Status, Clause),
578 tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
579 ( Status == merged
580 -> tdebug(merge, 'Turning leader ~p into follower', [Goal]),
581 '$tbl_wkl_make_follower'(Worklist),
582 shift_for_copy(call_info(Skeleton, Worklist))
583 ; true 584 ).
585
586activate(Skeleton, Worker, WorkList) :-
587 tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
588 ( reset_delays,
589 delim(Skeleton, Worker, WorkList, []),
590 fail
591 ; true
592 ).
593
607
608delim(Skeleton, Worker, WorkList, Delays) :-
609 reset(Worker, SourceCall, Continuation),
610 tdebug(wl_goal(WorkList, Goal, _)),
611 ( Continuation == 0
612 -> tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
613 tdebug(delay_goals(AllDelays, Cond)),
614 tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
615 [Skeleton, Goal, Cond]),
616 '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
617 Complete == !,
618 !
619 ; SourceCall = call_info(SrcSkeleton, SourceWL)
620 -> '$tbl_add_global_delays'(Delays, AllDelays),
621 tdebug(wl_goal(SourceWL, SrcGoal, _)),
622 tdebug(wl_goal(WorkList, DstGoal, _)),
623 tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
624 '$tbl_wkl_add_suspension'(
625 SourceWL,
626 dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
627 ; SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
628 -> '$tbl_add_global_delays'(Delays, AllDelays),
629 tdebug(wl_goal(SourceWL, SrcGoal, _)),
630 tdebug(wl_goal(WorkList, DstGoal, _)),
631 tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
632 '$tbl_wkl_add_suspension'(
633 SourceWL,
634 InstSkeleton,
635 dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
636 ; '$tbl_wkl_table'(WorkList, ATrie),
637 mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
638 -> delim(Skeleton, Continuation, WorkList, Delays)
639 ).
640
645
646'$moded_wrap_tabled'(Head, Options, ModeTest, WrapperNoModes, ModeArgs) :-
647 set_pattributes(Head, Options),
648 '$wrap_predicate'(Head, table, Closure, Wrapped,
649 ( ModeTest,
650 start_moded_tabling(Closure, Head, Wrapped,
651 WrapperNoModes, ModeArgs)
652 )).
653
654
655start_moded_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
656 '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie,
657 Status, Skeleton, IsMono),
658 ( IsMono == true
659 -> shift(dependency(Skeleton/ModeArgs, Trie, Mono)),
660 ( Mono == true
661 -> tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
662 ; start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
663 Trie, Status, Skeleton)
664 )
665 ; start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
666 Trie, Status, Skeleton)
667 ).
668
669start_moded_tabling_2(_Closure, Wrapper, Worker, ModeArgs,
670 Trie, Status, Skeleton) :-
671 ( Status == complete
672 -> moded_gen_answer(Trie, Skeleton, ModeArgs)
673 ; functor(Status, fresh, 2)
674 -> setup_call_catcher_cleanup(
675 '$idg_set_current'(OldCurrent, Trie),
676 moded_run_leader(Wrapper, Skeleton/ModeArgs,
677 Worker, Status, LStatus),
678 Catcher,
679 finished_leader(OldCurrent, Catcher, Status, Wrapper)),
680 tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
681 [Wrapper, ModeArgs, LStatus]),
682 moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
683 ; Status == invalid
684 -> reeval(Trie, Wrapper, Skeleton),
685 moded_gen_answer(Trie, Skeleton, ModeArgs)
686 ; 687 shift_for_copy(call_info(Skeleton/ModeArgs, Status))
688 ).
689
690:- public
691 moded_gen_answer/3. 692
693moded_gen_answer(Trie, Skeleton, ModedArgs) :-
694 trie_gen(Trie, Skeleton),
695 '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
696
697'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
698 trie_gen(ATrie, Skeleton),
699 '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
700
701moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
702 !,
703 moded_gen_answer(Trie, Skeleton, ModeArgs).
704moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
705 !,
706 '$tbl_free_component'(SCC),
707 moded_gen_answer(Trie, Skeleton, ModeArgs).
708moded_done_leader(_, _, _, _, _).
709
710moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
711 tdebug(wl_goal(Worklist, Goal, _)),
712 tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
713 moded_activate(SkeletonMA, Worker, Worklist),
714 tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
715 completion(SCC, Status, _Clause), 716 tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
717 ( Status == merged
718 -> tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
719 '$tbl_wkl_make_follower'(Worklist),
720 shift_for_copy(call_info(SkeletonMA, Worklist))
721 ; true 722 ).
723
724moded_activate(SkeletonMA, Worker, WorkList) :-
725 ( reset_delays,
726 delim(SkeletonMA, Worker, WorkList, []),
727 fail
728 ; true
729 ).
730
746
747:- public
748 update/7. 749
751update(0b11, Wrapper, M, Agg, New, Next, delete) :-
752 !,
753 M:'$table_update'(Wrapper, Agg, New, Next),
754 Agg \=@= Next.
756update(0b10, Wrapper, M, Agg, New, Next, keep) :-
757 !,
758 M:'$table_update'(Wrapper, Agg, New, Next0),
759 ( Next0 =@= Agg
760 -> Next = Agg
761 ; Next = Next0
762 ).
764update(0b01, Wrapper, M, Agg, New, Next, keep) :-
765 !,
766 M:'$table_update'(Wrapper, New, Agg, Next0),
767 ( Next0 =@= Agg
768 -> Next = Agg
769 ; Next = Next0
770 ).
772update(0b00, _Wrapper, _M, _Agg, New, New, keep) :-
773 !.
774
781
782completion(SCC, Status, Clause) :-
783 ( reset_delays,
784 completion_(SCC),
785 fail
786 ; '$tbl_table_complete_all'(SCC, Status, Clause),
787 tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
788 ).
789
790completion_(SCC) :-
791 repeat,
792 ( '$tbl_pop_worklist'(SCC, WorkList)
793 -> tdebug(wl_goal(WorkList, Goal, _)),
794 tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
795 completion_step(WorkList)
796 ; !
797 ).
798
825
827
828completion_step(SourceWL) :-
829 '$tbl_wkl_work'(SourceWL,
830 Answer, Continuation, TargetSkeleton, TargetWL, Delays),
831 tdebug(wl_goal(SourceWL, SourceGoal, _)),
832 tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
833 tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
834 tdebug(delay_goals(AllDelays, Cond)),
835 tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
836 [TargetGoal, SourceGoal, Answer, Cond]),
837 delim(TargetSkeleton, Continuation, TargetWL, Delays),
838 fail.
839
840
841 844
850
851tnot(Goal0) :-
852 '$tnot_implementation'(Goal0, Goal), 853 ( '$tbl_existing_variant_table'(_, Goal, Trie, Status, Skeleton),
854 Status \== invalid
855 -> '$idg_add_edge'(Trie),
856 ( '$tbl_answer_dl'(Trie, _, true)
857 -> fail
858 ; '$tbl_answer_dl'(Trie, _, _)
859 -> tdebug(tnot, 'tnot: adding ~p to delay list', [Goal]),
860 add_delay(Trie)
861 ; Status == complete
862 -> true
863 ; negation_suspend(Goal, Skeleton, Status)
864 )
865 ; tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
866 ( '$wrapped_implementation'(Goal, table, Implementation), 867 functor(Implementation, Closure, _),
868 start_tabling(Closure, Goal, Implementation),
869 fail
870 ; '$tbl_existing_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
871 tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
872 ( '$tbl_answer_dl'(Trie, _, true)
873 -> fail
874 ; '$tbl_answer_dl'(Trie, _, _)
875 -> add_delay(Trie)
876 ; NewStatus == complete
877 -> true
878 ; negation_suspend(Goal, NewSkeleton, NewStatus)
879 )
880 )
881 ).
882
883floundering(Goal) :-
884 format(string(Comment), 'Floundering goal in tnot/1: ~p', [Goal]),
885 throw(error(instantiation_error, context(_Stack, Comment))).
886
887
895
896negation_suspend(Wrapper, Skeleton, Worklist) :-
897 tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
898 '$tbl_wkl_negative'(Worklist),
899 shift_for_copy(call_info(Skeleton, tnot(Worklist))),
900 tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
901 '$tbl_wkl_is_false'(Worklist).
902
909
910not_exists(Goal) :-
911 ground(Goal),
912 '$get_predicate_attribute'(Goal, tabled, 1),
913 !,
914 tnot(Goal).
915not_exists(Goal) :-
916 ( tabled_call(Goal), fail
917 ; tnot(tabled_call(Goal))
918 ).
919
920 923
924add_delay(Delay) :-
925 '$tbl_delay_list'(DL0),
926 '$tbl_set_delay_list'([Delay|DL0]).
927
928reset_delays :-
929 '$tbl_set_delay_list'([]).
930
936
937'$wfs_call'(Goal, M:Delays) :-
938 '$tbl_delay_list'(DL0),
939 reset_delays,
940 call(Goal),
941 '$tbl_delay_list'(DL1),
942 ( delay_goals(DL1, M, Delays)
943 -> true
944 ; Delays = undefined
945 ),
946 '$append'(DL0, DL1, DL),
947 '$tbl_set_delay_list'(DL).
948
949delay_goals([], _, true) :-
950 !.
951delay_goals([AT+AN|T], M, Goal) :-
952 !,
953 ( integer(AN)
954 -> at_delay_goal(AT, M, G0, Answer, Moded),
955 ( '$tbl_is_trienode'(Moded)
956 -> trie_term(AN, Answer)
957 ; true 958 )
959 ; AN = Skeleton/ModeArgs
960 -> '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
961 M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
962 G0 = M1:G0plain
963 ; '$tbl_table_status'(AT, _, G0, AN)
964 ),
965 GN = G0,
966 ( T == []
967 -> Goal = GN
968 ; Goal = (GN,GT),
969 delay_goals(T, M, GT)
970 ).
971delay_goals([AT|T], M, Goal) :-
972 atrie_goal(AT, G0),
973 unqualify_goal(G0, M, G1),
974 GN = tnot(G1),
975 ( T == []
976 -> Goal = GN
977 ; Goal = (GN,GT),
978 delay_goals(T, M, GT)
979 ).
980
981at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
982 is_trie(Trie),
983 !,
984 at_delay_goal(Trie, M, Goal, Skeleton, Moded).
985at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
986 is_trie(Trie),
987 !,
988 '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
989 M2:'$table_mode'(Goal0, Variant, Moded),
990 unqualify_goal(M2:Goal0, M, Goal).
991
992atrie_goal(Trie, M:Goal) :-
993 '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
994 M:'$table_mode'(Goal, Variant, _Moded).
995
996unqualify_goal(M:Goal, M, Goal0) :-
997 !,
998 Goal0 = Goal.
999unqualify_goal(Goal, _, Goal).
1000
1001
1002 1005
1015
1016abolish_all_tables :-
1017 ( '$tbl_abolish_local_tables'
1018 -> true
1019 ; true
1020 ),
1021 ( '$tbl_variant_table'(VariantTrie),
1022 trie_gen(VariantTrie, _, Trie),
1023 '$tbl_destroy_table'(Trie),
1024 fail
1025 ; true
1026 ).
1027
1028abolish_private_tables :-
1029 ( '$tbl_abolish_local_tables'
1030 -> true
1031 ; ( '$tbl_local_variant_table'(VariantTrie),
1032 trie_gen(VariantTrie, _, Trie),
1033 '$tbl_destroy_table'(Trie),
1034 fail
1035 ; true
1036 )
1037 ).
1038
1039abolish_shared_tables :-
1040 ( '$tbl_global_variant_table'(VariantTrie),
1041 trie_gen(VariantTrie, _, Trie),
1042 '$tbl_destroy_table'(Trie),
1043 fail
1044 ; true
1045 ).
1046
1053
1054abolish_table_subgoals(SubGoal0) :-
1055 '$tbl_implementation'(SubGoal0, M:SubGoal),
1056 !,
1057 '$must_be'(acyclic, SubGoal),
1058 ( '$tbl_variant_table'(VariantTrie),
1059 trie_gen(VariantTrie, M:SubGoal, Trie),
1060 '$tbl_destroy_table'(Trie),
1061 fail
1062 ; true
1063 ).
1064abolish_table_subgoals(_).
1065
1069
1070abolish_module_tables(Module) :-
1071 '$must_be'(atom, Module),
1072 '$tbl_variant_table'(VariantTrie),
1073 current_module(Module),
1074 !,
1075 forall(trie_gen(VariantTrie, Module:_, Trie),
1076 '$tbl_destroy_table'(Trie)).
1077abolish_module_tables(_).
1078
1082
1083abolish_nonincremental_tables :-
1084 ( '$tbl_variant_table'(VariantTrie),
1085 trie_gen(VariantTrie, _, Trie),
1086 '$tbl_table_status'(Trie, Status, Goal, _),
1087 ( Status == complete
1088 -> true
1089 ; '$permission_error'(abolish, incomplete_table, Trie)
1090 ),
1091 \+ predicate_property(Goal, incremental),
1092 '$tbl_destroy_table'(Trie),
1093 fail
1094 ; true
1095 ).
1096
1103
1104abolish_nonincremental_tables(Options) :-
1105 ( Options = on_incomplete(Action)
1106 -> Action == skip
1107 ; '$option'(on_incomplete(skip), Options)
1108 ),
1109 !,
1110 ( '$tbl_variant_table'(VariantTrie),
1111 trie_gen(VariantTrie, _, Trie),
1112 '$tbl_table_status'(Trie, complete, Goal, _),
1113 \+ predicate_property(Goal, incremental),
1114 '$tbl_destroy_table'(Trie),
1115 fail
1116 ; true
1117 ).
1118abolish_nonincremental_tables(_) :-
1119 abolish_nonincremental_tables.
1120
1121
1122 1125
1132
1133current_table(Variant, Trie) :-
1134 ct_generate(Variant),
1135 !,
1136 current_table_gen(Variant, Trie).
1137current_table(Variant, Trie) :-
1138 current_table_lookup(Variant, Trie),
1139 !.
1140
1141current_table_gen(M:Variant, Trie) :-
1142 '$tbl_local_variant_table'(VariantTrie),
1143 trie_gen(VariantTrie, M:NonModed, Trie),
1144 M:'$table_mode'(Variant, NonModed, _Moded).
1145current_table_gen(M:Variant, Trie) :-
1146 '$tbl_global_variant_table'(VariantTrie),
1147 trie_gen(VariantTrie, M:NonModed, Trie),
1148 \+ '$tbl_table_status'(Trie, fresh), 1149 M:'$table_mode'(Variant, NonModed, _Moded).
1150
1151current_table_lookup(M:Variant, Trie) :-
1152 M:'$table_mode'(Variant, NonModed, _Moded),
1153 '$tbl_local_variant_table'(VariantTrie),
1154 trie_lookup(VariantTrie, M:NonModed, Trie).
1155current_table_lookup(M:Variant, Trie) :-
1156 M:'$table_mode'(Variant, NonModed, _Moded),
1157 '$tbl_global_variant_table'(VariantTrie),
1158 trie_lookup(VariantTrie, NonModed, Trie),
1159 \+ '$tbl_table_status'(Trie, fresh).
1160
1161ct_generate(M:Variant) :-
1162 ( var(Variant)
1163 -> true
1164 ; var(M)
1165 ).
1166
1167 1170
1171:- multifile
1172 system:term_expansion/2,
1173 tabled/2. 1174:- dynamic
1175 system:term_expansion/2. 1176
1177wrappers(Spec, M) -->
1178 { tabling_defaults(
1179 [ (table_incremental=true) - (incremental=true),
1180 (table_shared=true) - (tshared=true),
1181 (table_subsumptive=true) - ((mode)=subsumptive),
1182 call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
1183 ],
1184 #{}, Defaults)
1185 },
1186 wrappers(Spec, M, Defaults).
1187
1188wrappers(Var, _, _) -->
1189 { var(Var),
1190 !,
1191 '$instantiation_error'(Var)
1192 }.
1193wrappers(M:Spec, _, Opts) -->
1194 !,
1195 { '$must_be'(atom, M) },
1196 wrappers(Spec, M, Opts).
1197wrappers(Spec as Options, M, Opts0) -->
1198 !,
1199 { table_options(Options, Opts0, Opts) },
1200 wrappers(Spec, M, Opts).
1201wrappers((A,B), M, Opts) -->
1202 !,
1203 wrappers(A, M, Opts),
1204 wrappers(B, M, Opts).
1205wrappers(Name//Arity, M, Opts) -->
1206 { atom(Name), integer(Arity), Arity >= 0,
1207 !,
1208 Arity1 is Arity+2
1209 },
1210 wrappers(Name/Arity1, M, Opts).
1211wrappers(Name/Arity, Module, Opts) -->
1212 { '$option'(mode(TMode), Opts, variant),
1213 atom(Name), integer(Arity), Arity >= 0,
1214 !,
1215 functor(Head, Name, Arity),
1216 '$tbl_trienode'(Reserved)
1217 },
1218 qualify(Module,
1219 [ '$tabled'(Head, TMode),
1220 '$table_mode'(Head, Head, Reserved)
1221 ]),
1222 [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
1223 ].
1224wrappers(ModeDirectedSpec, Module, Opts) -->
1225 { '$option'(mode(TMode), Opts, variant),
1226 callable(ModeDirectedSpec),
1227 !,
1228 functor(ModeDirectedSpec, Name, Arity),
1229 functor(Head, Name, Arity),
1230 extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
1231 updater_clauses(Modes, Head, UpdateClauses),
1232 mode_check(Moded, ModeTest),
1233 ( ModeTest == true
1234 -> WrapClause = '$wrap_tabled'(Module:Head, Opts),
1235 TVariant = Head
1236 ; WrapClause = '$moded_wrap_tabled'(Module:Head, Opts, ModeTest,
1237 Module:Variant, Moded),
1238 TVariant = Variant
1239 )
1240 },
1241 qualify(Module,
1242 [ '$tabled'(Head, TMode),
1243 '$table_mode'(Head, TVariant, Moded)
1244 ]),
1245 [ (:- initialization(WrapClause, now))
1246 ],
1247 qualify(Module, UpdateClauses).
1248wrappers(TableSpec, _M, _Opts) -->
1249 { '$type_error'(table_desclaration, TableSpec)
1250 }.
1251
1252qualify(Module, List) -->
1253 { prolog_load_context(module, Module) },
1254 !,
1255 clist(List).
1256qualify(Module, List) -->
1257 qlist(List, Module).
1258
1259clist([]) --> [].
1260clist([H|T]) --> [H], clist(T).
1261
1262qlist([], _) --> [].
1263qlist([H|T], M) --> [M:H], qlist(T, M).
1264
1265
1266tabling_defaults([], Dict, Dict).
1267tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
1268 ( tabling_default(Condition)
1269 -> Dict1 = Dict0.put(Opt,Value)
1270 ; Dict1 = Dict0
1271 ),
1272 tabling_defaults(T, Dict1, Dict).
1273
1274tabling_default(Flag=FValue) :-
1275 !,
1276 current_prolog_flag(Flag, FValue).
1277tabling_default(call(Term)) :-
1278 call(Term).
1279
1281
1282subgoal_size_restraint(Level) :-
1283 current_prolog_flag(max_table_subgoal_size_action, abstract),
1284 current_prolog_flag(max_table_subgoal_size, Level).
1285
1289
1290table_options(Options, _Opts0, _Opts) :-
1291 var(Options),
1292 '$instantiation_error'(Options).
1293table_options((A,B), Opts0, Opts) :-
1294 !,
1295 table_options(A, Opts0, Opts1),
1296 table_options(B, Opts1, Opts).
1297table_options(subsumptive, Opts0, Opts1) :-
1298 !,
1299 put_dict(mode, Opts0, subsumptive, Opts1).
1300table_options(variant, Opts0, Opts1) :-
1301 !,
1302 put_dict(mode, Opts0, variant, Opts1).
1303table_options(incremental, Opts0, Opts1) :-
1304 !,
1305 put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
1306table_options(monotonic, Opts0, Opts1) :-
1307 !,
1308 put_dict(monotonic, Opts0, true, Opts1).
1309table_options(opaque, Opts0, Opts1) :-
1310 !,
1311 put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
1312table_options(lazy, Opts0, Opts1) :-
1313 !,
1314 put_dict(lazy, Opts0, true, Opts1).
1315table_options(dynamic, Opts0, Opts1) :-
1316 !,
1317 put_dict(dynamic, Opts0, true, Opts1).
1318table_options(shared, Opts0, Opts1) :-
1319 !,
1320 put_dict(tshared, Opts0, true, Opts1).
1321table_options(private, Opts0, Opts1) :-
1322 !,
1323 put_dict(tshared, Opts0, false, Opts1).
1324table_options(max_answers(Count), Opts0, Opts1) :-
1325 !,
1326 restraint(max_answers, Count, Opts0, Opts1).
1327table_options(subgoal_abstract(Size), Opts0, Opts1) :-
1328 !,
1329 restraint(subgoal_abstract, Size, Opts0, Opts1).
1330table_options(answer_abstract(Size), Opts0, Opts1) :-
1331 !,
1332 restraint(answer_abstract, Size, Opts0, Opts1).
1333table_options(Opt, _, _) :-
1334 '$domain_error'(table_option, Opt).
1335
1336restraint(Name, Value0, Opts0, Opts) :-
1337 '$table_option'(Value0, Value),
1338 ( Value < 0
1339 -> Opts = Opts0
1340 ; put_dict(Name, Opts0, Value, Opts)
1341 ).
1342
1343
1348
1349mode_check(Moded, Check) :-
1350 var(Moded),
1351 !,
1352 Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
1353mode_check(Moded, true) :-
1354 '$tbl_trienode'(Moded),
1355 !.
1356mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
1357 Moded =.. [s|Vars],
1358 var_check(Vars, Test).
1359
1360var_check([H|T], Test) :-
1361 ( T == []
1362 -> Test = var(H)
1363 ; Test = (var(H),Rest),
1364 var_check(T, Rest)
1365 ).
1366
1367:- public
1368 instantiated_moded_arg/1. 1369
1370instantiated_moded_arg(Vars) :-
1371 '$member'(V, Vars),
1372 \+ var(V),
1373 '$uninstantiation_error'(V).
1374
1375
1384
(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
1386 compound(ModeSpec),
1387 !,
1388 compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
1389 compound_name_arguments(Head, Name, HeadArgs),
1390 separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
1391 length(ModedArgs, Count),
1392 atomic_list_concat([$,Name,$,Count], VName),
1393 Variant =.. [VName|VariantArgs],
1394 ( ModedArgs == []
1395 -> '$tbl_trienode'(ModedAnswer)
1396 ; ModedArgs = [ModedAnswer]
1397 -> true
1398 ; ModedAnswer =.. [s|ModedArgs]
1399 ).
1400extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
1401 atomic_list_concat([$,Atom,$,0], Variant),
1402 '$tbl_trienode'(ModedAnswer).
1403
1411
1412separate_args([], [], [], [], []).
1413separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
1414 indexed_mode(HM),
1415 !,
1416 separate_args(TM, TA, TNA, Modes, TMA).
1417separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
1418 separate_args(TM, TA, TNA, Modes, TMA).
1419
1420indexed_mode(Mode) :- 1421 var(Mode),
1422 !.
1423indexed_mode(index). 1424indexed_mode(+). 1425
1430
1431updater_clauses([], _, []) :- !.
1432updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
1433 update_goal(P, S0,S1,S2, Body).
1434updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
1435 length(Modes, Len),
1436 functor(S0, s, Len),
1437 functor(S1, s, Len),
1438 functor(S2, s, Len),
1439 S0 =.. [_|Args0],
1440 S1 =.. [_|Args1],
1441 S2 =.. [_|Args2],
1442 update_body(Modes, Args0, Args1, Args2, true, Body).
1443
1444update_body([], _, _, _, Body, Body).
1445update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
1446 update_goal(P, A0,A1,A2, Goal),
1447 mkconj(Body0, Goal, Body1),
1448 update_body(TM, Args0, Args1, Args2, Body1, Body).
1449
1450update_goal(Var, _,_,_, _) :-
1451 var(Var),
1452 !,
1453 '$instantiation_error'(Var).
1454update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
1455 !,
1456 '$must_be'(atom, M),
1457 update_goal(lattice(PI), S0,S1,S2, Goal).
1458update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
1459 !,
1460 '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
1461 '$must_be'(atom, Name),
1462 Goal =.. [Name,S0,S1,S2].
1463update_goal(lattice(Head), S0,S1,S2, Goal) :-
1464 compound(Head),
1465 !,
1466 compound_name_arity(Head, Name, Arity),
1467 '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
1468 Goal =.. [Name,S0,S1,S2].
1469update_goal(lattice(Name), S0,S1,S2, Goal) :-
1470 !,
1471 '$must_be'(atom, Name),
1472 update_goal(lattice(Name/3), S0,S1,S2, Goal).
1473update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
1474 !,
1475 '$must_be'(oneof(integer, po_arity, [2]), Arity),
1476 '$must_be'(atom, Name),
1477 Call =.. [Name, S0, S1],
1478 Goal = (Call -> S2 = S0 ; S2 = S1).
1479update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
1480 !,
1481 '$must_be'(atom, M),
1482 '$must_be'(oneof(integer, po_arity, [2]), Arity),
1483 '$must_be'(atom, Name),
1484 Call =.. [Name, S0, S1],
1485 Goal = (M:Call -> S2 = S0 ; S2 = S1).
1486update_goal(po(M:Name), S0,S1,S2, Goal) :-
1487 !,
1488 '$must_be'(atom, M),
1489 '$must_be'(atom, Name),
1490 update_goal(po(M:Name/2), S0,S1,S2, Goal).
1491update_goal(po(Name), S0,S1,S2, Goal) :-
1492 !,
1493 '$must_be'(atom, Name),
1494 update_goal(po(Name/2), S0,S1,S2, Goal).
1495update_goal(Alias, S0,S1,S2, Goal) :-
1496 update_alias(Alias, Update),
1497 !,
1498 update_goal(Update, S0,S1,S2, Goal).
1499update_goal(Mode, _,_,_, _) :-
1500 '$domain_error'(tabled_mode, Mode).
1501
1502update_alias(first, lattice('$tabling':first/3)).
1503update_alias(-, lattice('$tabling':first/3)).
1504update_alias(last, lattice('$tabling':last/3)).
1505update_alias(min, lattice('$tabling':min/3)).
1506update_alias(max, lattice('$tabling':max/3)).
1507update_alias(sum, lattice('$tabling':sum/3)).
1508
1509mkconj(true, G, G) :- !.
1510mkconj(G1, G2, (G1,G2)).
1511
1512
1513 1516
1524
1525:- public first/3, last/3, min/3, max/3, sum/3. 1526
1527first(S, _, S).
1528last(_, S, S).
1529min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
1530max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
1531sum(S0, S1, S) :- S is S0+S1.
1532
1533
1534 1537
1542
1543'$set_table_wrappers'(Pred) :-
1544 ( '$get_predicate_attribute'(Pred, incremental, 1),
1545 \+ '$get_predicate_attribute'(Pred, opaque, 1)
1546 -> wrap_incremental(Pred)
1547 ; unwrap_incremental(Pred)
1548 ),
1549 ( '$get_predicate_attribute'(Pred, monotonic, 1)
1550 -> wrap_monotonic(Pred)
1551 ; unwrap_monotonic(Pred)
1552 ).
1553
1554 1557
1562
1563mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
1564 '$idg_add_mono_dyn_dep'(Dynamic,
1565 dependency(Dynamic, Cont, Skel),
1566 ATrie).
1567mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
1568 '$idg_add_monotonic_dep'(SrcTrie,
1569 dependency(SrcSkel, IsMono, Cont, Skel),
1570 ATrie).
1571
1579
1580monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
1581 '$idg_mono_affects_eager'(SrcTrie, ATrie,
1582 dependency(SrcSkel, IsMono, Cont, Skel)).
1583
1587
1588monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
1589 dyn_affected(Head, DTrie),
1590 '$idg_mono_affects_eager'(DTrie, ATrie,
1591 dependency(Head, Cont, Skel)).
1592
1598
1599wrap_monotonic(Head) :-
1600 '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
1601 '$start_monotonic'(Head, Wrapped)),
1602 '$pi_head'(PI, Head),
1603 prolog_listen(PI, monotonic_update).
1604
1608
1609unwrap_monotonic(Head) :-
1610 '$pi_head'(PI, Head),
1611 ( unwrap_predicate(PI, monotonic)
1612 -> prolog_unlisten(PI, monotonic_update)
1613 ; true
1614 ).
1615
1621
1622'$start_monotonic'(Head, Wrapped) :-
1623 ( '$tbl_collect_mono_dep'
1624 -> shift(dependency(Head)),
1625 tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
1626 Wrapped,
1627 tdebug(monotonic, ' --> ~p', [Head])
1628 ; Wrapped
1629 ).
1630
1634
1635:- public monotonic_update/2. 1636monotonic_update(Action, ClauseRef) :-
1637 ( atomic(ClauseRef) 1638 -> '$clause'(Head, _Body, ClauseRef, _Bindings),
1639 mon_propagate(Action, Head, ClauseRef)
1640 ; true
1641 ).
1642
1647
1648mon_propagate(Action, Head, ClauseRef) :-
1649 assert_action(Action),
1650 !,
1651 setup_call_cleanup(
1652 '$tbl_propagate_start'(Old),
1653 propagate_assert(Head), 1654 '$tbl_propagate_end'(Old)),
1655 forall(dyn_affected(Head, ATrie),
1656 '$mono_idg_changed'(ATrie, ClauseRef)). 1657mon_propagate(retract, Head, _) :-
1658 !,
1659 mon_invalidate_dependents(Head).
1660mon_propagate(rollback(Action), Head, _) :-
1661 mon_propagate_rollback(Action, Head).
1662
1663mon_propagate_rollback(Action, _Head) :-
1664 assert_action(Action),
1665 !.
1666mon_propagate_rollback(retract, Head) :-
1667 mon_invalidate_dependents(Head).
1668
1669assert_action(asserta).
1670assert_action(assertz).
1671
1675
1676propagate_assert(Head) :-
1677 tdebug(monotonic, 'Asserted ~p', [Head]),
1678 ( monotonic_dyn_affects(Head, Cont, Skel, ATrie),
1679 tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
1680 '$idg_set_current'(_, ATrie),
1681 pdelim(Cont, Skel, ATrie),
1682 fail
1683 ; true
1684 ).
1685
1690
1691incr_propagate_assert(Head) :-
1692 tdebug(monotonic, 'New dynamic answer ~p', [Head]),
1693 ( dyn_affected(Head, DTrie),
1694 '$idg_mono_affects'(DTrie, ATrie,
1695 dependency(Head, Cont, Skel)),
1696 tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
1697 '$idg_set_current'(_, ATrie),
1698 pdelim(Cont, Skel, ATrie),
1699 fail
1700 ; true
1701 ).
1702
1703
1707
1708propagate_answer(SrcTrie, SrcSkel) :-
1709 ( monotonic_affects(SrcTrie, SrcSkel, true, Cont, Skel, ATrie),
1710 tdebug(monotonic, 'Propagating tab ~p to ~p', [SrcTrie, ATrie]),
1711 pdelim(Cont, Skel, ATrie),
1712 fail
1713 ; true
1714 ).
1715
1725
1726pdelim(Worker, Skel, ATrie) :-
1727 reset(Worker, Dep, Cont),
1728 ( Cont == 0
1729 -> '$tbl_monotonic_add_answer'(ATrie, Skel),
1730 propagate_answer(ATrie, Skel)
1731 ; mon_assert_dep(Dep, Cont, Skel, ATrie),
1732 pdelim(Cont, Skel, ATrie)
1733 ).
1734
1740
1741mon_invalidate_dependents(Head) :-
1742 tdebug(monotonic, 'Invalidate dependents for ~p', [Head]),
1743 forall(dyn_affected(Head, ATrie),
1744 '$idg_mono_invalidate'(ATrie)).
1745
1751
1752abolish_monotonic_tables :-
1753 ( '$tbl_variant_table'(VariantTrie),
1754 trie_gen(VariantTrie, Goal, ATrie),
1755 '$get_predicate_attribute'(Goal, monotonic, 1),
1756 '$tbl_destroy_table'(ATrie),
1757 fail
1758 ; true
1759 ).
1760
1761 1764
1768
1769wrap_incremental(Head) :-
1770 tdebug(monotonic, 'Wrapping ~p', [Head]),
1771 abstract_goal(Head, Abstract),
1772 '$pi_head'(PI, Head),
1773 ( Head == Abstract
1774 -> prolog_listen(PI, dyn_update)
1775 ; prolog_listen(PI, dyn_update(Abstract))
1776 ).
1777
1778abstract_goal(M:Head, M:Abstract) :-
1779 compound(Head),
1780 '$get_predicate_attribute'(M:Head, abstract, 1),
1781 !,
1782 compound_name_arity(Head, Name, Arity),
1783 functor(Abstract, Name, Arity).
1784abstract_goal(Head, Head).
1785
1793
1794:- public dyn_update/2, dyn_update/3. 1795
1796dyn_update(_Action, ClauseRef) :-
1797 ( atomic(ClauseRef) 1798 -> '$clause'(Head, _Body, ClauseRef, _Bindings),
1799 dyn_changed_pattern(Head)
1800 ; true
1801 ).
1802
1803dyn_update(Abstract, _, _) :-
1804 dyn_changed_pattern(Abstract).
1805
1806dyn_changed_pattern(Term) :-
1807 forall(dyn_affected(Term, ATrie),
1808 '$idg_changed'(ATrie)).
1809
1810dyn_affected(Term, ATrie) :-
1811 '$tbl_variant_table'(VTable),
1812 trie_gen(VTable, Term, ATrie).
1813
1818
1819unwrap_incremental(Head) :-
1820 '$pi_head'(PI, Head),
1821 abstract_goal(Head, Abstract),
1822 ( Head == Abstract
1823 -> prolog_unlisten(PI, dyn_update)
1824 ; '$set_predicate_attribute'(Head, abstract, 0),
1825 prolog_unlisten(PI, dyn_update(_))
1826 ),
1827 ( '$tbl_variant_table'(VariantTrie)
1828 -> forall(trie_gen(VariantTrie, Head, ATrie),
1829 '$tbl_destroy_table'(ATrie))
1830 ; true
1831 ).
1832
1856
1857reeval(ATrie, Goal, Return) :-
1858 catch(try_reeval(ATrie, Goal, Return), deadlock,
1859 retry_reeval(ATrie, Goal)).
1860
1861retry_reeval(ATrie, Goal) :-
1862 '$tbl_reeval_abandon'(ATrie),
1863 tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
1864 sleep(0.000001),
1865 call(Goal).
1866
1867try_reeval(ATrie, Goal, Return) :-
1868 nb_current('$tbl_reeval', true),
1869 !,
1870 tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
1871 do_reeval(ATrie, Goal, Return).
1872try_reeval(ATrie, Goal, Return) :-
1873 tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
1874 findall(Path, false_path(ATrie, Path), Paths0),
1875 sort(0, @>, Paths0, Paths1),
1876 clean_paths(Paths1, Paths),
1877 tdebug(forall('$member'(Path, Paths),
1878 tdebug(reeval, ' Re-eval complete path: ~p', [Path]))),
1879 reeval_paths(Paths, ATrie),
1880 do_reeval(ATrie, Goal, Return).
1881
1882do_reeval(ATrie, Goal, Return) :-
1883 '$tbl_reeval_prepare_top'(ATrie, Clause),
1884 ( Clause == 0 1885 -> '$tbl_table_status'(ATrie, _Status, M:Variant, Return),
1886 M:'$table_mode'(Goal0, Variant, ModeArgs),
1887 Goal = M:Goal0,
1888 moded_gen_answer(ATrie, Return, ModeArgs)
1889 ; nonvar(Clause) 1890 -> trie_gen_compiled(Clause, Return)
1891 ; call(Goal) 1892 ).
1893
1894
1900
1901clean_paths([], []).
1902clean_paths([[_|Path]|T0], [Path|T]) :-
1903 clean_paths(T0, Path, T).
1904
1905clean_paths([], _, []).
1906clean_paths([[_|CPath]|T0], CPath, T) :-
1907 !,
1908 clean_paths(T0, CPath, T).
1909clean_paths([[_|Path]|T0], _, [Path|T]) :-
1910 clean_paths(T0, Path, T).
1911
1918
1919reeval_paths([], _) :-
1920 !.
1921reeval_paths(BottomUp, ATrie) :-
1922 is_invalid(ATrie),
1923 !,
1924 reeval_heads(BottomUp, ATrie, BottomUp1),
1925 tdebug(assertion(BottomUp \== BottomUp1)),
1926 '$list_to_set'(BottomUp1, BottomUp2),
1927 reeval_paths(BottomUp2, ATrie).
1928reeval_paths(_, _).
1929
1930reeval_heads(_, ATrie, []) :- 1931 \+ is_invalid(ATrie),
1932 !.
1933reeval_heads([], _, []).
1934reeval_heads([[H]|B], ATrie, BT) :- 1935 reeval_node(H),
1936 !,
1937 reeval_heads(B, ATrie, BT).
1938reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
1939 reeval_node(H),
1940 !,
1941 reeval_heads(B, ATrie, BT).
1942reeval_heads([FP|B], ATrie, [FP|BT]) :-
1943 reeval_heads(B, ATrie, BT).
1944
1945
1954
1955false_path(ATrie, BottomUp) :-
1956 false_path(ATrie, Path, []),
1957 '$reverse'(Path, BottomUp).
1958
1959false_path(ATrie, [ATrie|T], Seen) :-
1960 \+ memberchk(ATrie, Seen),
1961 '$idg_false_edge'(ATrie, Dep, Status),
1962 tdebug(reeval, ' ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
1963 ( Status == invalid
1964 -> ( false_path(Dep, T, [ATrie|Seen])
1965 -> true
1966 ; length(Seen, Len), 1967 T = [s(2, Len, [])] 1968 ) 1969 ; status_rank(Status, Rank),
1970 length(Seen, Len),
1971 T = [s(Rank,Len,Dep)]
1972 ).
1973
1974status_rank(dynamic, 2) :- !.
1975status_rank(monotonic, 2) :- !.
1976status_rank(complete, 1) :- !.
1977status_rank(Status, Rank) :-
1978 var(Rank),
1979 !,
1980 format(user_error, 'Re-eval from status ~p~n', [Status]),
1981 Rank = 0.
1982status_rank(Rank, Rank) :-
1983 format(user_error, 'Re-eval from rank ~p~n', [Rank]).
1984
1985is_invalid(ATrie) :-
1986 '$idg_falsecount'(ATrie, FalseCount),
1987 FalseCount > 0.
1988
2002
2003reeval_node(ATrie) :-
2004 '$tbl_reeval_prepare'(ATrie, M:Variant),
2005 !,
2006 M:'$table_mode'(Goal0, Variant, _Moded),
2007 Goal = M:Goal0,
2008 tdebug(reeval, 'Re-evaluating ~p', [Goal]),
2009 ( '$idg_reset_current',
2010 setup_call_cleanup(
2011 nb_setval('$tbl_reeval', true),
2012 ignore(Goal), 2013 nb_delete('$tbl_reeval')),
2014 fail
2015 ; tdebug(reeval, 'Re-evaluated ~p', [Goal])
2016 ).
2017reeval_node(ATrie) :-
2018 '$mono_reeval_prepare'(ATrie, Size),
2019 !,
2020 reeval_monotonic_node(ATrie, Size).
2021reeval_node(ATrie) :-
2022 \+ is_invalid(ATrie).
2023
2024reeval_monotonic_node(ATrie, Size) :-
2025 setup_call_cleanup(
2026 '$tbl_propagate_start'(Old),
2027 reeval_monotonic_node(ATrie, Size, Deps),
2028 '$tbl_propagate_end'(Old)),
2029 ( Deps == []
2030 -> tdebug(reeval, 'Re-evaluation for ~p complete', [ATrie])
2031 ; Deps == false
2032 -> tdebug(reeval, 'Re-evaluation for ~p queued new answers', [ATrie]),
2033 reeval_node(ATrie)
2034 ; tdebug(reeval, 'Re-evaluation for ~p: new invalid deps: ~p',
2035 [ATrie, Deps]),
2036 reeval_nodes(Deps),
2037 reeval_node(ATrie)
2038 ).
2039
2045
2046reeval_nodes([]).
2047reeval_nodes([H|T]) :-
2048 reeval_node(H),
2049 reeval_nodes(T).
2050
2051reeval_monotonic_node(ATrie, Size, Deps) :-
2052 tdebug(reeval, 'Re-evaluating lazy monotonic ~p', [ATrie]),
2053 ( '$idg_mono_affects_lazy'(ATrie, _0SrcTrie, Dep, DepRef, Answers),
2054 length(Answers, Count),
2055 '$idg_mono_empty_queue'(DepRef, Count),
2056 ( Dep = dependency(Head, Cont, Skel)
2057 -> ( '$member'(ClauseRef, Answers),
2058 '$clause'(Head, _Body, ClauseRef, _Bindings),
2059 tdebug(monotonic, 'Propagating ~p from ~p to ~p',
2060 [Head, _0SrcTrie, ATrie]),
2061 '$idg_set_current'(_, ATrie),
2062 pdelim(Cont, Skel, ATrie),
2063 fail
2064 ; true
2065 )
2066 ; Dep = dependency(SrcSkel, true, Cont, Skel)
2067 -> ( '$member'(Node, Answers),
2068 '$tbl_node_answer'(Node, SrcSkel),
2069 tdebug(monotonic, 'Propagating ~p from ~p to ~p',
2070 [Skel, _0SrcTrie, ATrie]),
2071 '$idg_set_current'(_, ATrie),
2072 pdelim(Cont, Skel, ATrie),
2073 fail
2074 ; true
2075 )
2076 ; tdebug(monotonic, 'Skipped queued ~p, answers ~p',
2077 [Dep, Answers])
2078 ),
2079 fail
2080 ; '$mono_reeval_done'(ATrie, Size, Deps)
2081 ).
2082
2083
2084 2087
2088system:term_expansion((:- table(Preds)), Expansion) :-
2089 \+ current_prolog_flag(xref, true),
2090 prolog_load_context(module, M),
2091 phrase(wrappers(Preds, M), Clauses),
2092 multifile_decls(Clauses, Directives0),
2093 sort(Directives0, Directives),
2094 '$append'(Directives, Clauses, Expansion).
2095
2096multifile_decls([], []).
2097multifile_decls([H0|T0], [H|T]) :-
2098 multifile_decl(H0, H),
2099 !,
2100 multifile_decls(T0, T).
2101multifile_decls([_|T0], T) :-
2102 multifile_decls(T0, T).
2103
2104multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
2105 !,
2106 functor(Head, Name, Arity).
2107multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
2108 !,
2109 functor(Head, Name, Arity).
2110multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
2111 !,
2112 functor(Head, Name, Arity).
2113multifile_decl(Head, (:- multifile(Name/Arity))) :-
2114 !,
2115 Head \= (:-_),
2116 functor(Head, Name, Arity).
2117
2118
2119 2122
2123:- public answer_completion/2. 2124
2138
2139answer_completion(AnswerTrie, Return) :-
2140 tdebug(trie_goal(AnswerTrie, Goal, _Return)),
2141 tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
2142 call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
2143 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
2144 ( Propagated > 0
2145 -> answer_completion(AnswerTrie, Return)
2146 ; true
2147 ).
2148
2149answer_completion_guarded(AnswerTrie, Return, Propagated) :-
2150 ( eval_subgoal_in_residual(AnswerTrie, Return),
2151 fail
2152 ; true
2153 ),
2154 delete_answers_for_failing_calls(Propagated),
2155 ( Propagated == 0
2156 -> mark_succeeding_calls_as_answer_completed
2157 ; true
2158 ).
2159
2165
2166delete_answers_for_failing_calls(Propagated) :-
2167 State = state(0),
2168 ( subgoal_residual_trie(ASGF, ESGF),
2169 \+ trie_gen(ESGF, _ETmp),
2170 tdebug(trie_goal(ASGF, Goal0, _)),
2171 tdebug(trie_goal(ASGF, Goal, _0Return)),
2172 '$trie_gen_node'(ASGF, _0Return, ALeaf),
2173 tdebug(ac(prune), ' Removing answer ~p from ~p', [Goal, Goal0]),
2174 '$tbl_force_truth_value'(ALeaf, false, Count),
2175 arg(1, State, Prop0),
2176 Prop is Prop0+Count-1,
2177 nb_setarg(1, State, Prop),
2178 fail
2179 ; arg(1, State, Propagated)
2180 ).
2181
2182mark_succeeding_calls_as_answer_completed :-
2183 ( subgoal_residual_trie(ASGF, _ESGF),
2184 ( '$tbl_answer_dl'(ASGF, _0Return, _True)
2185 -> tdebug(trie_goal(ASGF, Answer, _0Return)),
2186 tdebug(trie_goal(ASGF, Goal, _0Return)),
2187 tdebug(ac(prune), ' Completed ~p on ~p', [Goal, Answer]),
2188 '$tbl_set_answer_completed'(ASGF)
2189 ),
2190 fail
2191 ; true
2192 ).
2193
2194subgoal_residual_trie(ASGF, ESGF) :-
2195 '$tbl_variant_table'(VariantTrie),
2196 context_module(M),
2197 trie_gen(VariantTrie, M:eval_subgoal_in_residual(ASGF, _), ESGF).
2198
2203
2204eval_dl_in_residual(true) :-
2205 !.
2206eval_dl_in_residual((A;B)) :-
2207 !,
2208 ( eval_dl_in_residual(A)
2209 ; eval_dl_in_residual(B)
2210 ).
2211eval_dl_in_residual((A,B)) :-
2212 !,
2213 eval_dl_in_residual(A),
2214 eval_dl_in_residual(B).
2215eval_dl_in_residual(tnot(G)) :-
2216 !,
2217 tdebug(ac, ' ? tnot(~p)', [G]),
2218 current_table(G, SGF),
2219 '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
2220 tnot(eval_subgoal_in_residual(SGF, Return)).
2221eval_dl_in_residual(G) :-
2222 tdebug(ac, ' ? ~p', [G]),
2223 ( current_table(G, SGF)
2224 -> true
2225 ; more_general_table(G, SGF)
2226 -> true
2227 ; writeln(user_error, 'MISSING CALL? '(G)),
2228 fail
2229 ),
2230 '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
2231 eval_subgoal_in_residual(SGF, Return).
2232
2233more_general_table(G, Trie) :-
2234 term_variables(G, Vars),
2235 '$tbl_variant_table'(VariantTrie),
2236 trie_gen(VariantTrie, G, Trie),
2237 is_most_general_term(Vars).
2238
2239:- table eval_subgoal_in_residual/2. 2240
2245
2246eval_subgoal_in_residual(AnswerTrie, _Return) :-
2247 '$tbl_is_answer_completed'(AnswerTrie),
2248 !,
2249 undefined.
2250eval_subgoal_in_residual(AnswerTrie, Return) :-
2251 '$tbl_answer'(AnswerTrie, Return, Condition),
2252 tdebug(trie_goal(AnswerTrie, Goal, Return)),
2253 tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
2254 eval_dl_in_residual(Condition).
2255
2256
2257 2260
2266
2267:- public tripwire/3. 2268:- multifile prolog:tripwire/2. 2269
2270tripwire(Wire, _Action, Context) :-
2271 prolog:tripwire(Wire, Context),
2272 !.
2273tripwire(Wire, Action, Context) :-
2274 Error = error(resource_error(tripwire(Wire, Context)), _),
2275 tripwire_action(Action, Error).
2276
2277tripwire_action(warning, Error) :-
2278 print_message(warning, Error).
2279tripwire_action(error, Error) :-
2280 throw(Error).
2281tripwire_action(suspend, Error) :-
2282 print_message(warning, Error),
2283 break.
2284
2285
2286 2289
2290:- table
2291 system:undefined/0,
2292 system:answer_count_restraint/0,
2293 system:radial_restraint/0,
2294 system:tabled_call/1. 2295
2299
2300system:(undefined :-
2301 tnot(undefined)).
2302
2308
2309system:(answer_count_restraint :-
2310 tnot(answer_count_restraint)).
2311
2312system:(radial_restraint :-
2313 tnot(radial_restraint)).
2314
2315system:(tabled_call(X) :- call(X))