lazy_lists.pl -- Lazy list handling
This module builds a lazy list from a predicate that fetches a slice of this list. In addition it provides interactors (slice constructors) for several common use cases for lazy lists, such as reading objects of several sizes from files (characters, lines, terms), reading messages from message queues and reading answers from engines.
Lazy lists are lists that end in a constraint. Trying to unify the constraint forces the next slice of the list to be fetched and added to the list.
The typical use case for lazy lists is to run a DCG grammar on it. For example, an agent may be listening on a socket and turn the line-based message protocol into a list using the fragment below.
..., tcp_open(Socket, Read, Write), lazy_list(lazy_read_lines(Read, [as(codes)]), List), phrase(action, List).
Typically, the iterator works on a globally allocated object that is not always subject to garbage collection. In such cases, the skeleton usage follows the pattern below:
setup_call_cleanup( <open resource>(R), ( lazy_list(<iterator>(R), List), process_list(List) ), <close resource>(R))
This is rather unfortunately, but there is no way we can act on the fact that List is no further accessed. In some cases, e.g., message queues or engines, the resource is subject to (atom) garbage collection.
- lazy_list(:Next, -List)
- Create a lazy list from a callback. Next is called repeatedly to
extend the list. It is called as
call(Next, List, Tail)
, where the difference list List\Tail produces the next slice of the list. If the end of the input is reached, List must be a proper list and Tail must be[]
. - lazy_list(:Next, +State0, -List)
- Create a lazy list where the next element is defined by
call(Next, State0, State1, Head)
The example below uses this predicate to define a lazy list holding the Fibonacci numbers. Our state keeps the two previous Fibonacci numbers.
fibonacci_numbers(L) :- lazy_list(fib, state(-,-), L). fib(state(-,-), state(0,-), 0) :- !. fib(state(0,-), state(1,0), 1) :- !. fib(state(P,Q), state(F,P), F) :- F is P+Q.
The above can be used to retrieve the Nth Fibonacci number. As fib/2 provides no access to the complete list of Fibonacci numbers, this can be used to generate large Fibonacci numbers.
fib(N, F) :- fibonacci_numbers(L), nth1(N, L, F).
- lazy_list_materialize(?List) is det
- Materialize the lazy list.
- lazy_list_length(+List, -Len) is det
- True if Len is the length of the materialized lazy list. Note that length/2 reports the length of the currently materialized part and on backtracking longer lists.
- lazy_list_iterator(+Iterator, -Next, :GetNext, :TestEnd)
- Directive to create a lazy list iterator from a predicate that gets a single next value.
- lazy_get_codes(+Stream, +N, -List, -Tail)
- Lazy list iterator to get character codes from a stream.
- lazy_read_terms(+Stream, +Options, -List, -Tail)
- Turn a stream into a lazy list of Prolog terms. Options are
passed to read_term/3, except for:
- chunk(ChunkSize)
- Determines the read chunk size. Default is 10.
- lazy_read_lines(+Stream, +Options, -List, -Tail) is det
- Lazy list iterator to read lines from Stream. Options include:
- chunk(ChunkSize)
- Determines the read chunk size. Default is 10.
- as(+Type)
- Determine the output type for each line. Valid values are
atom
,string
,codes
orchars
. Default isstring
.
- lazy_message_queue(+Queue, +Options, -List, -Tail) is det
- Lazy list iterator for message queues. Options are passed to
thread_get_message/3. In addition, the following options are
processed:
- chunk(ChunkSize)
- Determines the read chunk size. Default is 1.
A thread can listen to its own message queue using
thread_self(Me), lazy_list(lazy_message_queue(Me, []), List), phrase(action(List)).
- lazy_engine_next(+Engine, +N, -List, -Tail)
- Lazy list iterator for engines. This is used to implement lazy_findall/3,4.
- lazy_findall(?Templ, :Goal, -List) is det
- lazy_findall(+ChunkSize, ?Templ, :Goal, -List) is det
- True when List is a lazy list containing the instantiations for Template for each answer of Goal. Goal is executed in an engine (see engine_create/3).
Undocumented predicates
The following predicates are exported, but not or incorrectly documented.