342faf6d89
- uncutable predicates; - call_cleanup/2. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@615 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
121 lines
2.4 KiB
Prolog
121 lines
2.4 KiB
Prolog
:- module( cleanup, [
|
|
call_cleanup/2,
|
|
call_cleanup/1,
|
|
on_cleanup/1,
|
|
cleanup_all/0
|
|
]).
|
|
|
|
/*
|
|
public interface:
|
|
|
|
call_cleanup(Goal).
|
|
call_cleanup(Goal,CleanUpGoal).
|
|
Goal will be called in a cleanup-context, where any registered
|
|
CleanUpGoal inside of that context will be called when Goal is left,
|
|
either by a fail, cut or exeption.
|
|
It is possible to nest cleanup contexts.
|
|
|
|
on_cleanup(CleanUpGoal).
|
|
registers CleanUpGoal to the current cleanup context.
|
|
CleanUpGoal's are executed in reverse order of their registration.
|
|
throws an exception if called outside of any cleanup-context.
|
|
|
|
cleanup_all.
|
|
calls all pending CleanUpGoals and resets the cleanup-system to an initial state.
|
|
should only be used as one of the last calls in the main program.
|
|
|
|
|
|
hidden predicates:
|
|
most private predicates could also be used in special cases, such as manually setting up cleanup-contexts.
|
|
Read the Source.
|
|
*/
|
|
|
|
|
|
:- meta_predicate
|
|
call_cleanup(:,:),
|
|
call_cleanup(:),
|
|
on_cleanup(:),
|
|
on_cleanup(?,:),
|
|
on_cleanupz(:),
|
|
on_cleanupz(?,:).
|
|
|
|
|
|
:- initialization(init_cleanup).
|
|
init_cleanup :-
|
|
get_value('cleanup:level',[]),
|
|
set_value('cleanup:level',0).
|
|
init_cleanup.
|
|
|
|
|
|
% call goal G with a cleanup CL in a cleanup context
|
|
call_cleanup(G,CL) :-
|
|
needs_cleanup(L),
|
|
on_cleanup(L,CL),
|
|
(
|
|
catch(G,X,(do_cleanup(L),throw(X)))
|
|
;
|
|
do_cleanup(L)
|
|
).
|
|
|
|
|
|
% call a goal G in a cleanup context
|
|
call_cleanup(G) :-
|
|
needs_cleanup(L),
|
|
(
|
|
catch(G,X,(do_cleanup(L),throw(X)))
|
|
;
|
|
do_cleanup(L)
|
|
).
|
|
|
|
|
|
% begin cleanup level
|
|
needs_cleanup(CL) :-
|
|
get_value('cleanup:level',L),
|
|
CL is L + 1,
|
|
set_value('cleanup:level',CL).
|
|
|
|
|
|
% leave cleanup level, call all registred cleanup predicates within
|
|
do_cleanup(CL) :-
|
|
CN is CL - 1,
|
|
set_value('cleanup:level',CN),
|
|
next_cleanup(CL).
|
|
|
|
next_cleanup(CL) :-
|
|
!,recorded(cleanup:handle,(L,G),R),
|
|
CL =< L,
|
|
erase(R),
|
|
(call(G);true),
|
|
next_cleanup(CL).
|
|
|
|
|
|
% clean up all remaining stuff / reinitialize cleanup-module
|
|
cleanup_all :- do_cleanup(1).
|
|
|
|
|
|
% register a cleanup predicate (normal reverse-order cleanup)
|
|
on_cleanup(G) :-
|
|
get_value('cleanup:level',L),
|
|
on_cleanup(L,G).
|
|
|
|
on_cleanup(L,G) :-
|
|
L =< 0,
|
|
throw(no_cleanup_context(G)).
|
|
on_cleanup(L,G) :-
|
|
callable(G),
|
|
recorda(cleanup:handle,(L,G),_).
|
|
|
|
|
|
% register a cleanup predicate (reverse-reverse-order cleanup)
|
|
on_cleanupz(G) :-
|
|
get_value('cleanup:level',L),
|
|
on_cleanupz(L,G).
|
|
|
|
on_cleanupz(L,G) :-
|
|
L =< 0,
|
|
throw(no_cleanup_context(G)).
|
|
on_cleanupz(L,G) :-
|
|
callable(G),
|
|
recordz(cleanup:handle,(L,G),_).
|
|
|