diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Christian patches for call_cleanup and documentation.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@633 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2002-10-11 03:39:11 +00:00
parent 523fae9544
commit efc7c1c5a6
3 changed files with 197 additions and 99 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
library/Makefile.in
View File

@@ -28,6 +28,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/atts.yap \
$(srcdir)/avl.yap \
$(srcdir)/charsio.yap \
$(srcdir)/cleanup.yap \
$(srcdir)/heaps.yap \
$(srcdir)/lists.yap \
$(srcdir)/logtalk.yap \

117
library/cleanup.yap
View File

@@ -1,3 +1,33 @@
% 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,
@@ -5,33 +35,13 @@
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.
:- multifile user:goal_expansion/3.
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.
:- user_defined_directive(fragile(G), cleanup:cleanup_expansion(G)).
:- op(1150, fx,fragile).
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
:- meta_predicate
call_cleanup(:,:),
call_cleanup(:),
on_cleanup(:),
@@ -42,11 +52,13 @@ Read the Source.
:- initialization(init_cleanup).
init_cleanup :-
get_value('cleanup:level',[]),
set_value('cleanup:level',0).
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),
@@ -70,15 +82,19 @@ call_cleanup(G) :-
% begin cleanup level
needs_cleanup(CL) :-
get_value('cleanup:level',L),
bb_get(cleanup_level,L),
CL is L + 1,
set_value('cleanup:level',CL).
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,
set_value('cleanup:level',CN),
bb_put(cleanup_level,CN),
next_cleanup(CL).
next_cleanup(CL) :-
@@ -88,19 +104,19 @@ next_cleanup(CL) :-
(call(G);true),
next_cleanup(CL).
% clean up all remaining stuff / reinitialize cleanup-module
cleanup_all :- do_cleanup(1).
cleanup_all :-
do_cleanup(1).
cleanup_all.
% register a cleanup predicate (normal reverse-order cleanup)
on_cleanup(G) :-
get_value('cleanup:level',L),
bb_get(cleanup_level,L),
on_cleanup(L,G).
on_cleanup(L,G) :-
L =< 0,
throw(no_cleanup_context(G)).
throw(error(instantiation_error,no_cleanup_context(G))).
on_cleanup(L,G) :-
callable(G),
recorda(cleanup:handle,(L,G),_).
@@ -108,7 +124,7 @@ on_cleanup(L,G) :-
% register a cleanup predicate (reverse-reverse-order cleanup)
on_cleanupz(G) :-
get_value('cleanup:level',L),
bb_get(cleanup_level,L),
on_cleanupz(L,G).
on_cleanupz(L,G) :-
@@ -118,3 +134,32 @@ 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),cleanup_expansion(T).
cleanup_expansion(G/A) :-
atom(G),integer(A),!,
compose_var_goal(G/A,GG),
\+ clause(user:goal_expansion(GG,M,NG),_), % TODO: match body too
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(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).