1/* Part of SWI-Prolog
    2
    3    Author:        Douglas R. Miles, ...
    4    E-mail:        logicmoo@gmail.com
    5    WWW:           http://www.logicmoo.org
    6    Copyright (c)  2016-2017, LogicMOO Basic Tools
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15                   
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(each_call_cleanup,
   36   [
   37      each_call_cleanup/3,             % +Setup, +Goal, +Cleanup      
   38      each_call_catcher_cleanup/4,     % +Setup, +Goal, ?Catcher, +Cleanup
   39      redo_call_cleanup/3,             % +Setup, +Goal, +Cleanup
   40      trusted_redo_call_cleanup/3      % +Setup, +Goal, +Cleanup
   41    ]).

Each call cleanup

Call Setup Goal Cleanup Each Iteration

See also
- https://groups.google.com/forum/#!searchin/comp.lang.prolog/redo_call_cleanup%7Csort:relevance/comp.lang.prolog/frH_4RzMAHg/2bBub5t6AwAJ

*/

   51:- meta_predicate
   52  redo_call_cleanup(0,0,0),
   53  call_then_cut(0),
   54  each_call_catcher_cleanup(0,0,?,0),
   55  each_call_cleanup(0,0,0),
   56  trusted_redo_call_cleanup(0,0,0).   57
   58
   59
   60% call_then_cut(G):- call((G,(deterministic(true)->!;true)))
   61
   62call_then_cut(G):- 
   63  prolog_current_choice(CP),  
   64  prolog_choice_attribute(CP,parent,PC),
   65  prolog_choice_attribute(PC,frame,Frame),prolog_frame_attribute(Frame,goal,PG),
   66     prolog_choice_attribute(CP,frame,CFrame),prolog_frame_attribute(CFrame,goal,CG),nop(dmsg(call_then_cut(PG,CG))),
   67  call((G,(deterministic(true)->prolog_cut_to(PC);true))).
   68
   69
   70
   71:- module_transparent(pt1/1).   72:- module_transparent(pt2/1).
 redo_call_cleanup(:Setup, :Goal, :Cleanup)
@warn Setup/Cleanup do not share variables. If that is needed, use each_call_cleanup/3
   80redo_call_cleanup(Setup,Goal,Cleanup):- 
   81   assertion(each_call_cleanup:unshared_vars(Setup,Goal,Cleanup)),
   82   trusted_redo_call_cleanup(Setup,Goal,Cleanup).
   83
   84trusted_redo_call_cleanup(Setup,Goal,Cleanup):- 
   85   \+ \+ '$sig_atomic'(Setup),
   86   catch( 
   87     ((Goal, deterministic(DET)),
   88       '$sig_atomic'(Cleanup),
   89         (DET == true -> !
   90          ; (true;('$sig_atomic'(Setup),fail)))), 
   91      E, 
   92      ('$sig_atomic'(Cleanup),throw(E))). 
 each_call_catcher_cleanup(:Setup, :Goal, +Catcher, :Cleanup)
Call Setup before Goal like normal but also before each Goal is redone. Also call Cleanup each time Goal is finished @bug Goal does not share variables with Setup/Cleanup Pairs
  100each_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup):-
  101   setup_call_catcher_cleanup(true, 
  102     each_call_cleanup(Setup, Goal, Cleanup), Catcher, true).
  103
  104:- thread_local(ecc:'$each_call_cleanup'/2).  105:- thread_local(ecc:'$each_call_undo'/2).
 each_call_cleanup(:Setup, :Goal, :Cleanup)
Call Setup before Goal like normal but also before each Goal is redone. Also call Cleanup each time Goal is finished @bug Goal does not share variables with Setup/Cleanup Pairs
  113each_call_cleanup(Setup,Goal,Cleanup):- 
  114 ((ground(Setup);ground(Cleanup)) -> 
  115  trusted_redo_call_cleanup(Setup,Goal,Cleanup);
  116  setup_call_cleanup(
  117   asserta((ecc:'$each_call_cleanup'(Setup,Cleanup)),HND), 
  118   trusted_redo_call_cleanup(pt1(HND),Goal,pt2(HND)),
  119   (pt2(HND),erase(HND)))).
  120
  121 		 /*******************************
  122		 *	  UTILITIES		*
  123		 *******************************/
  124
  125ecc:throw_failure(Why):- throw(error(assertion_error(Why),_)).
  126
  127pt1(HND) :- 
  128   clause(ecc:'$each_call_cleanup'(Setup,Cleanup),true,HND) 
  129   ->
  130   ('$sig_atomic'(Setup) -> 
  131     asserta(ecc:'$each_call_undo'(HND,Cleanup)) ; 
  132       ecc:throw_failure(failed_setup(Setup)))
  133   ; 
  134   ecc:throw_failure(pt1(HND)).
  135
  136pt2(HND) :- 
  137  retract(ecc:'$each_call_undo'(HND,Cleanup)) ->
  138    ('$sig_atomic'(Cleanup)->true ;ecc:throw_failure(failed_cleanup(Cleanup)));
  139      ecc:throw_failure(failed('$each_call_undo'(HND))).
  140
  141:- if(true).  142:- system:import(each_call_cleanup/3).  143:- system:import(each_call_catcher_cleanup/4).  144:- system:import(redo_call_cleanup/3).  145:- system:import(pt1/1).  146:- system:import(pt2/1).  147:- endif.  148
  149% Only checks for shared vars (not shared structures)
  150% @TODO what if someone got tricky with setarging?
  151unshared_vars(Setup,_,_):- ground(Setup),!.
  152unshared_vars(Setup,Goal,Cleanup):- 
  153   term_variables(Setup,SVs),
  154   term_variables(Cleanup,CVs),
  155   ( CVs==[] -> true; unshared_set(SVs,CVs)),
  156   term_variables(Goal,GVs),
  157   ( GVs==[] -> true; 
  158     (unshared_set(SVs,GVs),
  159      unshared_set(CVs,GVs))).
  160
  161unshared_set([],_).
  162unshared_set([E1|Set1],Set2):- 
  163   not_in_identical(E1,Set2),
  164   unshared_set(Set1,Set2).
  165
  166not_in_identical(X, [Y|Ys]) :- X \== Y, not_in_identical(X, Ys)