1:- module(ccstate, [ run_state_handler//3, run_state//1, run_state//2 , run_nb_state//1
    2                   , set/1, set/2, get/1, get/2, app/1, app/2, upd/2
    3                   ]).

Stateful computation as an effect using delimited control

This module provides two kinds of stateful computation, one which undoes state changes on backtracking (run_state//{1,2,3}) and another which preserves state changes on backtracking (run_nb_state//1).
On top this are built two execution contexts which provide mutable references (run_ref/1) and a mutable environment (run_env/1). */
   14:- use_module(library(delimcc), [p_reset/3, p_shift/2]).   15
   16:- set_prolog_flag(generate_debug_info, false).   17
   18% stateful operators
   19:- meta_predicate app(2), app(+,2).   20app(Pr,P)  :- p_shift(Pr, app(P)).
   21get(Pr,S)  :- p_shift(Pr, get(S)).
   22set(Pr,S)  :- p_shift(Pr, set(S)).
   23
   24app(P)     :- app(state, P).
   25get(S)     :- get(state, S).
   26set(S)     :- set(state, S).
   27upd(S1,S2) :- app(upd(S1,S2)).
   28
   29upd(S1,S2,S1,S2).
   30
   31% ------- stateful computation reified as DCG ----------
   32:- meta_predicate run_state_handler(+,3,0,?,?), run_state(0,?,?), run_state(+,0,?,?),
   33                  run_nb_state(0,+,-), run_nb_state(+,0,+,-).
 run_state_handler(+Pr:prompt(R), +H:pred(+R,S,S), +G:pred, S1:S, S2:S) is det
Run P in an context where handler H is available process requests with state threaded through DCG style.
   39run_state_handler(Pr,H,G) --> {p_reset(Pr,G,Stat)}, cont_sh(Stat,Pr,H).
   40
   41cont_sh(susp(Req,Cont),Pr,H) --> call(H,Req), run_state_handler(Pr,H,Cont).
   42cont_sh(done,_,_) --> [].
 run_state(+Pr:prompt, +P:pred, S1:S, S2:S) is det
 run_state(+P:pred, S1:S, S2:S) is det
Run P in an context that allows set/1 and get/1 to be used to to handle a mutable state, initially S1. The final state is unified with S2. run_state/3 uses the prompt state. State changes are undone on backtracking. run_state(Pr,G,S1,S2) is equivalent to run_state_handler(Pr,handle,Goal,S1,S2).
   52run_state(Goal) --> run_state(state, Goal).
   53run_state(Prompt, Goal) -->
   54   {p_reset(Prompt, Goal, Status)},
   55   cont_state(Status, Prompt).
   56
   57cont_state(done,_) --> [].
   58cont_state(susp(R,Cont), Prompt) --> handle(R), run_state(Prompt, Cont).
   59
   60handle(get(S),S,S).
   61handle(set(S),_,S).
   62handle(app(P),S1,S2) :- call(P,S1,S2).
 run_nb_state(+Pr:prompt, +P:pred, +S1:S, -S2:S) is det
 run_nb_state(+P:pred, +S1:S, -S2:S) is det
Run P in a context where get/1 and set/1 manipulate a mutable state, similar to run_state/3, but state changes are not undone on backtracking. Note that, to ensure preservation of state on backtracking, set/1 saves a copy of the given term, not the term itself. Implementation uses nb_getval/2 and nb_setval/2 with a dynamically generated key. run_nb_state/3 uses prompt state.

Note that using this can be quite expensive if the state is large due to the copying that occurs whenever it is changed.

   76run_nb_state(Goal) --> run_nb_state(state, Goal).
   77run_nb_state(Prompt, Goal, S1, S2) :-
   78   gensym(nbs,Key),
   79   setup_call_cleanup( nb_setval(Key, S1),
   80                       (run_nb(Prompt, Goal, Key), nb_getval(Key, S2)),
   81                       nb_delete(Key)).
   82
   83run_nb(Prompt, Goal, Key) :-
   84   p_reset(Prompt, Goal, Status),
   85   cont_nb_state(Status, Prompt, Key).
   86
   87cont_nb_state(done, _, _).
   88cont_nb_state(susp(R,Cont), Prompt, Key) :- handle_nb(R,Key), run_nb(Prompt, Cont, Key).
   89
   90handle_nb(get(S),Key) :- nb_getval(Key,S).
   91handle_nb(set(S),Key) :- nb_setval(Key,S).
   92handle_nb(app(P),Key) :- nb_getval(Key,S1), call(P,S1,S2), nb_setval(Key,S2)