1:- module(tap_main, []).    2
    3:- use_module(library(tap/raw), [
    4    tap_state/1,
    5    term_wants_tap_expansion/0
    6]).    7:- use_module(library(lists), [append/3]).    8
    9:- dynamic user:main/0.   10user:term_expansion(end_of_file, _) :-
   11    % build main/0
   12    term_wants_tap_expansion,
   13    prolog_load_context(script, true),
   14    findall(tap_call(Head), tap:test_case(Head), Tests0),
   15    length(Tests0, TestCount),
   16    tap_state(State0),
   17    thread_state(Tests0, Tests1, State0, State),
   18    append(Tests1, [tap_raw:tap_footer(TestCount, State0, State)], Tests2),
   19    xfy_list(',', Body, [tap_raw:tap_header(TestCount)|Tests2]),
   20    user:assertz((main :- Body)),
   21
   22    % undo all database side effects
   23    tap:retractall(test_case(_)),
   24    fail.
   25
   26% Thread a state variable through a list of predicates.  This is similar
   27% to a DCG expansion, but much simpler.
   28thread_state([], [], Out, Out).
   29thread_state([P0|Preds0], [tap_raw:P|Preds], In, Out) :-
   30    P0 =.. [Functor|Args],
   31    append(Args, [In, Tmp], NewArgs),
   32    P =.. [Functor|NewArgs],
   33    thread_state(Preds0, Preds, Tmp, Out).
   34
   35% Identical to list_util:xfy_list/3.  Copied here so that library(tap)
   36% can have no pack dependencies.  That lets other packs use library(tap)
   37% without circular dependencies.
   38xfy_list(Op, Term, [Left|List]) :-
   39    Term =.. [Op, Left, Right],
   40    xfy_list(Op, Right, List),
   41    !.
   42xfy_list(_, Term, [Term])