169 lines
4.1 KiB
Prolog
169 lines
4.1 KiB
Prolog
% cleanup.yap
|
|
% Copyright (C) 2002 by Christian Thaeter
|
|
%
|
|
% public interface:
|
|
%
|
|
% :- fragile name/arity.
|
|
% declares the predicate denoted by name/arity as fragile predicate.
|
|
% Whenever such a fragile predicate is used in a query it will be
|
|
% called through call_cleanup/1.
|
|
%
|
|
% 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.
|
|
|
|
:- module( cleanup, [
|
|
call_cleanup/2,
|
|
call_cleanup/1,
|
|
on_cleanup/1,
|
|
cleanup_all/0,
|
|
op(1150, fx,fragile)
|
|
]).
|
|
|
|
|
|
:- multifile user:goal_expansion/3.
|
|
|
|
:- user_defined_directive(fragile(G), cleanup:cleanup_expansion(G)).
|
|
|
|
:- meta_predicate
|
|
call_cleanup(:,:),
|
|
call_cleanup(:),
|
|
on_cleanup(:),
|
|
on_cleanup(?,:),
|
|
on_cleanupz(:),
|
|
on_cleanupz(?,:).
|
|
|
|
|
|
:- initialization(init_cleanup).
|
|
init_cleanup :-
|
|
bb_put(expansion_toggle,1),
|
|
\+ bb_get(cleanup_level,_),
|
|
bb_put(cleanup_level,0).
|
|
% TODO: would be nice to register cleanup_all into the
|
|
% toplevel to be called after each query is finished
|
|
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) :-
|
|
bb_get(cleanup_level,L),
|
|
CL is L + 1,
|
|
bb_put(cleanup_level,CL).
|
|
|
|
|
|
cleanup_context(CL) :-
|
|
bb_get(cleanup_level,CL).
|
|
|
|
|
|
% leave cleanup level, call all registred cleanup predicates within
|
|
do_cleanup(CL) :-
|
|
CN is CL - 1,
|
|
bb_put(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).
|
|
cleanup_all.
|
|
|
|
% register a cleanup predicate (normal reverse-order cleanup)
|
|
on_cleanup(G) :-
|
|
bb_get(cleanup_level,L),
|
|
on_cleanup(L,G).
|
|
|
|
on_cleanup(L,G) :-
|
|
L =< 0,
|
|
throw(error(instantiation_error,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) :-
|
|
bb_get(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),_).
|
|
|
|
% helpers
|
|
cleanup_expansion(X) :-
|
|
var(X),!,throw(error(instantiation_error,fragile(X))).
|
|
cleanup_expansion((H,T)) :- !,cleanup_expansion(H),cleanup_expansion(T).
|
|
cleanup_expansion([H,T]) :- !, cleanup_expansion(H),
|
|
( T = [] -> true ; cleanup_expansion(T) ).
|
|
cleanup_expansion(M:G/A) :-
|
|
atom(G),integer(A),!,
|
|
compose_var_goal(G/A,GG),
|
|
\+ user:goal_expansion(GG,M,call_cleanup(M:GG)),
|
|
assert(( user:goal_expansion(GG,M,NG)
|
|
:- bb_get(expansion_toggle,1)
|
|
-> bb_put(expansion_toggle,0),
|
|
NG=call_cleanup(M:GG)
|
|
; bb_put(expansion_toggle,1),
|
|
NG=M:GG )).
|
|
cleanup_expansion(G/A) :-
|
|
!,prolog_flag(typein_module,M),cleanup_expansion(M:G/A).
|
|
cleanup_expansion(X) :-
|
|
!,throw(error(instantiation_error,fragile(X))).
|
|
|
|
compose_var_goal(G/A,NG) :-
|
|
arity_to_vars(A,L), NG =.. [G|L].
|
|
|
|
arity_to_vars(N,L) :-
|
|
arity_to_vars(N,[],L).
|
|
arity_to_vars(N,L1,L2) :-
|
|
N > 0,
|
|
NN is N-1,
|
|
LT = [L|L1],
|
|
arity_to_vars(NN,LT,L2).
|
|
arity_to_vars(0,L,L).
|