1:- module(sb_assert, [
    2    sb_assertz/2,
    3    sb_retract/1,
    4    sb_retractall/1
    5]).    6
    7:- use_module(library(stache)).    8
    9:- dynamic wrapper_ref/3.   10
   11% Stateful, backtrackable assertz.
   12:- meta_predicate sb_assertz(?, :).   13sb_assertz(State, M:Term) =>
   14    $(nonvar(Term)),
   15    $(term_head_body(Term, H, B)),
   16    $(setup_wrapper(M, (H :- B))),
   17    $(stash(term_state((H :- B), State))).
   18
   19sb_retract(Term) :-
   20    rummage(term_state(Term, State)),
   21    $(unstash(term_state(Term, State))),
   22    $(same_functor(Term, H)),
   23    (rummage_lazy(term_state(H, _))
   24    ->  true
   25    ;   $(term_headfunctor(Term, F/A)),
   26        $(retract(wrapper_ref(F/A, Ref))),
   27        $(erase(Ref))).
   28
   29sb_retractall(H) :-
   30    $(copy_term(H, H_)),
   31    (sb_retract(H_)
   32    ->  sb_retractall(H)
   33    ;   true).
   34
   35term_head_body(T, H, B), nonvar(T) =>
   36    T = (H_ :- B_)
   37    ->  H = H_, B = B_
   38    ;   H = T, B = true.
   39
   40setup_wrapper(M, (H :- _B)) =>
   41    functor(H, F, A),
   42    setup_wrapper_(M, F/A).
   43
   44setup_wrapper_(M, F/A) =>
   45    wrapper_ref(F/A, M, _)
   46    ->  true
   47    ;   functor(H, F, A),
   48        b_assertz(M:(H :- sb_assert:eval(H, M)), Ref),
   49        b_assertz(wrapper_ref(F/A, M, Ref), _).
   50
   51eval(H, M) :-
   52    $(same_functor(H, H_)),
   53    rummage(term_state((H_ :- B_), State)),
   54    copy_term((H_ :- B_)-State, (H :- B)-State),
   55    call(M:B).
   56
   57term_headfunctor(Term, F/A) :-
   58    Term = (H :- _)
   59    ->  $(functor(H, F, A))
   60    ;   $(functor(Term, F, A)).
   61
   62:- det(b_assertz/2).   63b_assertz(Term, Ref) =>
   64    $(assertz(Term, Ref)),
   65    undo(erase(Ref))