1flow_to_llist(Flow,List) :-
    2    NbList = nblist(Flow, unknown, unknown),
    3    freeze(List, flow_to_llist_(List, NbList)).
    4
    5flow_to_llist_([], NbList) :-
    6    nblist_empty(NbList),
    7    !.
    8flow_to_llist_([H|T], NbList0) :-
    9    nblist_head_tail(NbList0, Head, NbList),
   10    H = Head,
   11    ( nblist_empty(NbList) -> % terminate list as soon as possible
   12        T = []
   13    ; true -> % more content available, fetch it on demand
   14        freeze(T, flow_to_llist_(T, NbList))
   15    ).
 at_eof(+Flow) is semidet
True if Flow can provide no more values. eof = "end of flow"
   21:- discontiguous at_eof/1.
 next(+Flow, -X) is semidet
True if X is the next value from Flow. Fails if Flow can provide no more values. next/2 should only fail if it's impossible to determine whether more values are available until trying to fetch them. Otherwise, it's more efficienct for at_eof/1 to just succeed in the first place.
   31:- discontiguous next/2.
 finalize_value(+X0, -X) is det
True if a flow value X0 is finalized to X. This allows a flow to produce values that are different from the ones a user finally sees.
   38:- discontiguous finalize_value/3.   39
   40
   41% We want lines/2 to work on all streams, even if they can't be
   42% repositioned. For example, network streams communicating with a
   43% line-based protocol. However, the lazy list on which users operate
   44% must support backtracking so that it behaves as they expect.
   45%
   46% To support both goals, we build a custom, non-backtrackable list in
   47% memory. Data read from a stream is permanently stored in this list.
   48% The user's list backtracks as it pleases and reconstructs itself from
   49% the underlying, non-bactrackable list.
   50%
   51% nb_setarg/3 is picky about how it operates. Mistakes lead to
   52% unexpected backtracking behavior. I've noted these deviations from
   53% standard practice with "because nb_setarg/3" in the comments below.
   54%
   55% Incidentally, on a large file (57,000 lines), this implementation is
   56% about twice as fast (2s vs 4s) as the old one because it doesn't spend
   57% time calling set_stream_position/2.
   58
   59% :- type nblist ---> nblist(stream, atomic, nblist).
   60%
   61% The second, atomic argument can be `known(Val)`, `unknown` or `end_of_file`.
   62% We can't use variables because nb_setarg/3.
   63
   64% is our nblist empty?
   65nblist_empty(nblist(_,end_of_file,_)) :-
   66    !.
   67nblist_empty(NbList) :-
   68    NbList = nblist(Flow, _, _),  % don't unify in head, because nb_setarg/3
   69    at_eof(Flow),
   70    nb_setarg(2,NbList,end_of_file).
   71
   72
   73% access the head and tail of our nblist
   74nblist_head_tail(nblist(Flow,H,T), Head, Tail) :-
   75    % do we already know the head value?
   76    H=known(V),
   77    !,
   78    finalize_value(Flow,V,Head),
   79    Tail = T.
   80nblist_head_tail(NbList, Head, Tail) :-
   81    % don't know the head value, read it from the stream
   82    NbList = nblist(Flow, unknown, _),  % don't unify in head, because nb_setarg/3
   83    next(Flow,H),
   84    nb_setarg(2, NbList, known(H)),
   85    nb_setarg(3, NbList, nblist(Flow,unknown,unknown)),
   86
   87    % now that side effects are done we can unify
   88    finalize_value(Flow,H,Head),
   89    nblist(_,_,Tail) = NbList