2:- module(test_tcf, []).    3
    4:- set_module(class(library)).    5
    6
    7:- meta_predicate(try_call_finally(0,0,0)).    8:- export(try_call_finally/3).    9try_call_finally(S, G, C) :-
   10   call_cleanup_(S, C),
   11   deterministic_(G, F),
   12   (F == true, !; call_cleanup_(C, S)).
   13
   14/*
   15deterministic_(G, F) :-
   16   G,
   17   deterministic(F),
   18   otherwise. /* prevent tail recursion */
   19*/
   20call_cleanup_(G, C) :-
   21   call_cleanup((G; fail), C). /* prevent early determinism */
   22
   23
   24/*
   25:- dynamic(try_c_f_state/1).
   26try_c_f_state(W):- writeln(W=true).
   27
   28:- 
   29    WriteFalse = ( try_c_f_state(W):- writeln(W=false), ! ),
   30    setup_call_cleanup_each(
   31         asserta(WriteFalse,Ref),
   32         ( (X=1;X=2), try_c_f_state(X) ),
   33         erase(Ref)), 
   34    try_c_f_state(X),
   35    fail.
   36  
   37  ?- main.
   38  
   39  1=false
   40  1=true
   41  2=false
   42  2=true
   43*/
   44is_try_call_finally_pred(try_call_finally).
   45is_try_call_finally_pred(each_call_cleanup).
   46
   47try_try_call_finally1:- test_try_call_finally(1,try_call_finally).
   48
   49test_try_call_finally(1,P):-
   50 is_try_call_finally_pred(P),
   51 doall((
   52
   53  assert((try_c_f_state(W):- writeln(W=true))),
   54
   55  WriteFalse = ( try_c_f_state(W):- writeln(W=false), ! ),
   56  call(P,
   57       asserta(WriteFalse,Ref),
   58       ( member(X,[1,2,3]), try_c_f_state(X) ),
   59       erase(Ref)), 
   60  try_c_f_state(X)
   61
   62 )).
   63
   64/*
   65?- try_call_finally(writeln('in'), member(X,[1,2,3]), writeln('out')).
   66  in
   67  out
   68  X = 1 ;
   69  in
   70  out
   71  X = 2 ;
   72  in
   73  out
   74  X = 3.
   75*/
   76try_try_call_finally2:-
   77  try_call_finally(
   78      writeln('in'), 
   79      member(X,[1,2,3]), 
   80      writeln('out')),
   81  writeln('X'=X).
   82  fail.
   83try_try_call_finally2.
   84
   85/*
   86:-  try_call_finally(
   87       gensym(hi_,X),
   88       member(N,[1,2,3]),
   89       write(X=N)),
   90    fail.
   91
   92hi_0 = 1
   93hi_1 = 2
   94hi_2 = 3
   95No.
   96*/
   97
   98try_try_call_finally3:- 
   99   try_call_finally(
  100       gensym(hi_,X),
  101       member(N,[1,2,3]),
  102       writeln(c(X=N))),
  103   writeln(o(X=N)),
  104   fail.
  105try_try_call_finally3.
  106
  107% ?- try_call_finally(writeln('in'), member(X,[1,2,3]), writeln('out')).
  108% in
  109% out
  110% X = 1 ;
  111% in
  112% out
  113% X = 2 ;
  114% in
  115% out
  116% X = 3.
  117
  118redo_call_cleanup_v1(Setup,Call,Cleanup):-
  119   CallCleanup = call(Cleanup),
  120   CleanupOnce = (CallCleanup, b_setarg(1,CallCleanup,true)),
  121   SetupAndClean = (Setup,undo(CleanupOnce)),
  122   call_cleanup( 
  123     (SetupAndClean, Call, undo(SetupAndClean)), 
  124     CleanupOnce).
  125
  126redo_call_cleanup_v2(Setup,Call,Cleanup):-
  127   CallCleanup = call(Cleanup),
  128   CleanupOnce = (CallCleanup, b_setarg(1,CallCleanup,true)),
  129   call_cleanup(
  130      (repeat,Setup,undo(CleanupOnce), 
  131         (Call*-> true 
  132           /*kill repeat*/ 
  133           ;(!,fail)), 
  134         (deterministic(true) -> ! ; CleanupOnce)),
  135    CleanupOnce).
  136/*
  137no_trace(Goal):-  
  138   notrace(notrace),!,
  139      setup_call_cleanup(
  140        notrace,
  141        (undo(notrace),Goal,trace),
  142        trace).
  143*/
  144:- fixup_exports.