1:- module(canny_payloads,
    2          [ payload/1,                  % +M:Payload/{ToArity, OfArity}
    3            apply_to/1,                 % +M:To/Arity or +M:To/Arities
    4            apply_to/2,                 % +Apply, +M:To
    5            property_of/1,              % +M:Of/Arity or +M:Of/Arities
    6            property_of/2               % +Property, +M:Of
    7          ]).    8
    9:- meta_predicate
   10    payload(:),
   11    apply_to(:),
   12    apply_to(+, :),
   13    property_of(:),
   14    property_of(+, :).   15
   16:- use_module(arity).

Local Payloads

Apply and Property terms must be non-variable. The list below indicates the valid forms of Apply, indicating determinism. Note that only peek and pop perform non-deterministically for all thread-local payloads.

Properties as follows.

The first form top/1 peeks at the latest payload once. It behaves semi-deterministically for the top-most payload.

/

   42:- thread_local payload/2.
 payload(:PI) is det
Makes public multi-file apply-to and property-of predicates using the predicate indicator PI of the form M:Payload/{ToArity, OfArity} where arity specifications define the arity or arities for a payload. Defines predicates M:apply_to_Payload/ToArity and M:property_of_Payload/OfArity for module M. Allows comma-separated lists of arities.
   53payload(M:Payload/{ToArity, OfArity}) :-
   54    apply_to(M:Payload/ToArity),
   55    property_of(M:Payload/OfArity).
 visible(+Prefix, +Suffix, +Args, :Head) is semidet
Finds visible predicates named by concatenating Prefix with Suffix, with Args specifying the number of arguments and also residing within a given module, M. Unifies the result at Head.
Arguments:
Prefix- atom, either apply_to_ or property_of_.
Suffix- must be an instantiated atom. You cannot pass a variable. Fails otherwise.
   68visible(Prefix, Suffix, Args, M:Head) :-
   69    atom(Suffix),
   70    atomic_concat(Prefix, Suffix, Name),
   71    Head =.. [Name|Args],
   72    predicate_property(M:Head, visible).
   73
   74apply_to(M:To/Arity) :-
   75    integer(Arity),
   76    !,
   77    atomic_concat(apply_to_, To, Name),
   78    multifile(M:Name/Arity),
   79    public(M:Name/Arity).
   80apply_to(M:To/Arities) :-
   81    arities(Arities, Arities_),
   82    forall(member(Arity, Arities_), apply_to(M:To/Arity)).
 apply_to(+Apply, :To) is nondet
apply_to(+Applies, :To) is semidet
Arguments:
Applies- is a list of Apply terms. It succeeds when all its Apply terms succeed, and fails when the first one fails, possibly leaving side effects if the apply-to predicate generates addition effects; though typically not for mutation arity-3 apply-to predicates.
   93apply_to(Apply, _M:_To) :- var(Apply), !, fail.
   94apply_to(reset, M:To) :- !, retractall(payload(M:To, _)).
   95apply_to(push, M:To) :-
   96    !,
   97    of(M:To, [new, Payload], Head),
   98    M:Head,
   99    asserta(payload(M:To, Payload)).
  100apply_to(peek(Payload), M:To) :- !, payload(M:To, Payload).
  101apply_to(pop(Payload), M:To) :- !, retract(payload(M:To, Payload)).
  102apply_to(Applies, M:To) :-
  103    is_list(Applies),
  104    !,
  105    to(M:To, [_, _, _], Head),
  106    functor(Head, Name, 3),
  107    once(apply_to(peek(Payload0), M:To)),
  108    foldl(M:Name, Applies, Payload0, Payload),
  109    once(apply_to(pop(_Payload0), M:To)),
  110    asserta(payload(M:To, Payload)).
  111apply_to(Apply, M:To) :- to(M:To, [Apply], Head), M:Head.
  112
  113to(M:To, Args, Head) :- visible(apply_to_, To, Args, M:Head).
  114
  115property_of(M:Of/Arity) :-
  116    integer(Arity),
  117    !,
  118    atomic_concat(property_of_, Of, Name),
  119    multifile(M:Name/Arity),
  120    public(M:Name/Arity).
  121property_of(M:Of/Arities) :-
  122    arities(Arities, Arities_),
  123    forall(member(Arity, Arities_), property_of(M:Of/Arity)).
 property_of(+Property, :Of) is nondet
Finds Property of some payload where the second argument M:Of defines the module M and payload atom Of.

Property top/1 peeks semi-deterministically at the top-most payload for some given property.

  133property_of(Property, _M:_Of) :- var(Property), !, fail.
  134property_of(top(Property), M:Of) :-
  135    !,
  136    once(apply_to(peek(Payload), M:Of)),
  137    of(M:Of, [Property, Payload], Head),
  138    M:Head.
  139property_of(Property, M:Of) :- of(M:Of, [Property], Head), M:Head.
  140
  141of(M:Of, Args, Head) :- visible(property_of_, Of, Args, M:Head)