Did you know ... Search Documentation:
Pack nan_system_sources -- prolog/nan/system/sources.pl
PublicShow source

Part of Nan.System.Sources (nan/system/sources.pl)

Module sources (nan/system/sources.pl) provides the predicates that implement Answer Sources in Prolog.

For code docs syntax and meaning see sources_docs.txt.

NOTE:

  • Predicates in this module are not synchronised.
  • Predicates in this module do not validate their input.
author
- Julio P. Di Egidio
version
- 1.2.0-beta
license
- GNU GPLv3
To be done
- Extend from fluents to interactors (implement yield/1).
 using_source(@TSol:any, @GExe:callable, -Src:source, :GUse:callable) is nondet
Creates a source, calls a goal, finally destroys the source.

Ensures destruction of the source even if goal throws an error.

  • GExe invoked as GExe() is nondet.
  • GUse invoked as GUse() is nondet.

Example:

?- using_source(I, between(1, 2, I), _S,
   (   repeat,
       source_next(_S, answer(_Det, the(I))),
       (_Det == last -> !; true)
   )).
I = 1 ;
I = 2.
Arguments:
TSol- The source's solution template (copied).
GExe- The source's goal to execute (copied).
Src- The new source.
GUse- The goal to execute.
 using_source_com(+Srcs:list(source), :GCom:callable, -Src:source, :GUse:callable) is nondet
Creates a combined source, calls a goal, finally destroys the source.

Ensures destruction of the source even if goal throws an error.

  • GCom invoked as GCom(Srcs, Src) is det.
  • GUse invoked as GUse() is nondet.

Example:

?- [user].
parallel_com(Srcs, Src) :-
    GRst = parallel_com__rst,
    GNxt = parallel_com__nxt,
    source_create_com(Srcs, GRst, GNxt, _, Src).

parallel_com__rst(Srcs, _, _) :-
    maplist(source_reset, Srcs).

parallel_com__nxt(Srcs, _, _, Ans) :-
    maplist(source_next_begin, Srcs),
    foldl(parallel_com__nxt__do, Srcs, [], As),
    Ans = answer(more, the(As)).

parallel_com__nxt__do(Src, As0, As) :-
    source_next_end(Src, A),
    append(As0, [A], As).
^Z

?- using_source(1, sleep(1), _S1,
   using_source(2, sleep(1), _S2,
   using_source_com([_S1, _S2], parallel_com, _S,
   (   time(source_next(_S, answer(more, the(Anss))))
   )))).  % Warm run
% 188 inferences, 0.000 CPU in 1.000 seconds (0% CPU, Infinite Lips)
Anss = [answer(last, the(1)), answer(last, the(2))].
Arguments:
Srcs- The sources to combine.
GCom- The combination constructor.
Src- The new combined source.
GUse- The goal to execute.
 source_create(@TSol:any, @GExe:callable, -Src:source) is det
Creates a source.
  • GExe invoked as GExe() is nondet.
Arguments:
TSol- The solution template (copied).
GExe- The goal to execute (copied).
Src- The new source.
 source_create_com(+Srcs:list(source), @GRst:callable, @GNxt:callable, @Sta0:any, -Src:source) is det
Creates a combined source.
  • GRst invoked as GRst(Srcs, Sta0, Sta1) is det.
  • GNxt invoked as GNxt(Srcs, Sta0, Sta1, Ans) is det.

Enforces determinism on GRst and GNxt.

For an example, see using_source_com/4.

Arguments:
Srcs- The sources to combine.
GRst- The goal to reset the combinator to its initial state (copied).
GNxt- The goal to get the next answer from the combinator (copied).
Sta0- The initial state of the combinator (copied).
Src- The new combined source.
 source_destroy(+Src:source) is det
Destroys a source.
Arguments:
Src- The source.
throws
- source_error(does_not_exist(Src))
 source_destroy_all is semidet
Destroys all existing sources.

Fails if no source exists.

 source_reset(+Src:source) is det
Resets a source to its initial state.
Arguments:
Src- The source.
throws
- source_error(does_not_exist(Src))
 source_next(+Src:source, ?Ans:answer) is det
Gets the next answer from a source.
Arguments:
Src- The source.
Ans- The answer.
throws
- source_error(does_not_exist(Src))
 source_next_begin(+Src:source) is det
Begins getting the next answer from a source (async).
Arguments:
Src- The source.
throws
- source_error(does_not_exist(Src))
 source_next_end(+Src:source, ?Ans:answer) is det
Ends getting the next answer from a source (async).
Arguments:
Src- The source.
Ans- The answer.
throws
- source_error(does_not_exist(Src))
 source_exists(+Src:source) is semidet
Tests that a source exists.
Arguments:
Src- The source to test for.