34
   35:- module(wfs,
   36          [ call_residual_program/2,               37
   38            call_delays/2,                         39            delays_residual_program/2,             40            answer_residual/2,                     41
   42            op(900, fy, tnot)
   43          ]).   44:- autoload(library(apply),[maplist/3]).   45:- autoload(library(error),[instantiation_error/1,permission_error/3]).   46:- autoload(library(lists),[list_to_set/2,member/2]).
   55:- meta_predicate
   56    call_delays(0, :),
   57    delays_residual_program(:, :),
   58    call_residual_program(0, :),
   59    answer_residual(:, :).
   70call_delays(Goal, Delays) :-
   71    '$wfs_call'(Goal, Delays).
   81delays_residual_program(GM:Delays, M:Clauses) :-
   82    phrase(residual_program(Delays, GM, [], _), Program),
   83    maplist(unqualify_clause(M), Program, Clauses0),
   84    list_to_set(Clauses0, Clauses).
   90call_residual_program(Goal, M:Clauses) :-
   91    '$wfs_call'(Goal, 0:R0),                       92    phrase(residual_program(R0, M, [], _), Program),
   93    maplist(unqualify_clause(M), Program, Clauses).
   94
   95
   96residual_program(Var, _, _, _) -->
   97    { var(Var),
   98      !,
   99      instantiation_error(Var)
  100    }.
  101residual_program(M:G, _, Done0, Done) -->
  102    !,
  103    residual_program(G, M, Done0, Done).
  104residual_program(true, _, Done, Done) -->
  105    !.
  106residual_program(undefined, _, Done, Done) -->
  107    !.
  108residual_program(G, M, Done, Done) -->
  109    { member(M:G2, Done),
  110      G2 =@= G
  111    }, !.
  112residual_program((A;B), M, Done0, Done) -->
  113    !,
  114    residual_program(A, M, Done0, Done1),
  115    residual_program(B, M, Done1, Done).
  116residual_program((A,B), M, Done0, Done) -->
  117    !,
  118    residual_program(A, M, Done0, Done1),
  119    residual_program(B, M, Done1, Done).
  120residual_program(tnot(A), M, Done0, Done) -->
  121    !,
  122    residual_program(A, M, Done0, Done).
  123residual_program(Goal0, M, Done0, Done) -->
  124    { predicate_property(M:Goal0, imported_from(M2))
  125    },
  126    !,
  127    residual_program(Goal0, M2, Done0, Done).
  128residual_program(Goal, M, Done0, Done) -->
  129    { M:'$table_mode'(Goal, Variant, ModeArgs),
  130      (   current_table(M:Variant, Trie)
  131      ->  true
  132      ;   '$tabling':more_general_table(M:Variant, Trie)
  133      ),
  134      !,
  135      '$tbl_table_status'(Trie, _Status, M:Variant, Skeleton),
  136      copy_term(Skeleton, Skeleton2),
  137      (   (   '$tbl_is_trienode'(ModeArgs)
  138          ->  '$tbl_answer'(Trie, Skeleton2, Condition0)
  139          ;   '$tbl_answer'(Trie, Skeleton2, ModeArgs, Condition0)
  140          ),
  141          Skeleton2 =@= Skeleton
  142      ->  Skeleton2 = Skeleton
  143      ),
  144      as_cond(Condition0, Condition)
  145    },
  146    [ (M:Goal :- Condition) ],
  147    residual_program(Condition, M, [M:Goal|Done0], Done).
  148residual_program(Goal, M, Done, Done) -->
  149    { format(user_error, 'OOPS: Missing Call? ~p', [M:Goal])
  150    },
  151    [ (M:Goal :- ???) ].
  152
  153as_cond((M:Variant)/ModeArgs, M:Goal) :-
  154    !,
  155    M:'$table_mode'(Goal, Variant, ModeArgs).
  156as_cond(Goal, Goal).
  157
  158unqualify_clause(M, (Head0 :- Body0), (Head :- Body)) :-
  159    unqualify(Head0, M, Head),
  160    unqualify(Body0, M, Body).
  169answer_residual(Goal, M:Residual) :-
  170    predicate_property(Goal, tabled(_)),
  171    !,
  172    '$tbl_variant_table'(VariantTrie),
  173    trie_gen(VariantTrie, Goal, Trie),
  174    '$tbl_table_status'(Trie, _Status, Goal, Skeleton),
  175    '$tbl_answer'(Trie, Skeleton, Condition),
  176    unqualify(Condition, M, Residual).
  177answer_residual(Goal, _) :-
  178    permission_error(answer_residual, non_tabled_procedure, Goal).
  179
  180unqualify((A0;B0), M, G) :-
  181    !,
  182    G = (A;B),
  183    unqualify(A0, M, A),
  184    unqualify(B0, M, B).
  185unqualify((A0,B0), M, G) :-
  186    !,
  187    G = (A,B),
  188    unqualify(A0, M, A),
  189    unqualify(B0, M, B).
  190unqualify(tnot(A0), M, G) :-
  191    !,
  192    G = tnot(A),
  193    unqualify(A0, M, A).
  194unqualify(M:G0, MG, G) :-
  195    '$c_current_predicate'(_, MG:G0),
  196    predicate_property(MG:G0, imported_from(M)),
  197    !,
  198    G = G0.
  199unqualify(M:G0, M, G) :-
  200    !,
  201    G = G0.
  202unqualify(system:G0, _, G) :-
  203    !,
  204    G = G0.
  205unqualify(G, _, G)
 
Well Founded Semantics interface
The library(wfs) provides the user interface to the Well Founded Semantics (WFS) support in SWI-Prolog. */