1:- module(ccref, [ run_ref/1, ref_new/2, ref_get/2, ref_set/2, ref_app/2, ref_app_ref/2, ref_maybe_app_ref/2, ref_upd/3 ]).

Delimited context providing mutable references */

    4:- use_module(library(ccstate), [run_state/4, app/2]).    5:- use_module(library(data/store)).    6
    7:- meta_predicate run_ref(0), ref_app(+,2), ref_app_ref(+,2), ref_maybe_app_ref(+,2).
 run_ref(+P:pred) is det
Run P inside a run_state/4 with the prompt set to ref, providing a supply of mutable references using ref_new/2, ref_get/2, ref_set/3 etc.
   12run_ref(Goal) :-
   13   store_new(S),
   14   run_state(ref, Goal, S, _).
   15
   16ref_new(X,R) :- app(ref, store_add(X,R)).
   17ref_get(R,X) :- app(ref, store_get(R,X)).
   18ref_set(R,X) :- app(ref, store_set(R,X)).
   19ref_app(R,P) :- app(ref, store_apply(R,P)).
   20ref_upd(R,X,Y) :- app(ref, store_upd(R,X,Y)).
 ref_app_ref(+R:ref(A), +P:pred(+A,-P)) is det
Use P to update contents of R, like ref_app/2, but with references still available as a computational effect.
   25ref_app_ref(R,P) :- app(ref, lifted_app(R,P)).
   26
   27lifted_app(R,P) -->
   28   store_get(R,X1),
   29   run_state(ref, call(P,X1,X2)),
   30   store_set(R,X2).
 ref_maybe_app_ref(+R:ref(A), +P:pred(+A,-maybe(A))) is det
Call P with contents of R, with references still in context, possibly updating R with a new value.
   35ref_maybe_app_ref(R,P) :- app(ref, lifted_app_maybe(R,P)).
   36
   37lifted_app_maybe(R,P) -->
   38   store_get(R,X1),
   39   run_state(ref, call(P,X1,MX2)),
   40   ({MX2 = just(X2)} -> store_set(R,X2); [])