This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/depth_bound.yap
vsc e5f4633c39 This commit was generated by cvs2svn to compensate for changes in r4,
which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2001-04-09 19:54:03 +00:00

215 lines
6.3 KiB
Prolog

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: corout.pl *
* Last rev: *
* mods: *
* comments: Coroutines implementation *
* *
*************************************************************************/
%depth_bound_call(A,D) :-
%write(depth_bound_call(A,D)), nl, fail.
depth_bound_call(A,D) :-
'$execute_under_depth_limit'(A,D).
$old_depth_bound_call(A,D) :-
'$check_callable'(A,A),
'$user_call_depth_limited'(A, D).
'$user_call_depth_limited'(V,D) :- var(V), !,
throw(error(instantiation_error,V)).
'$user_call_depth_limited'(A,D) :- number(A), !,
throw(error(type_error(callable,A),A,D)).
'$user_call_depth_limited'(R,D) :- db_reference(R), !,
throw(error(type_error(callable,R),R)).
'$user_call_depth_limited'(A,D) :-
'$access_yap_flags'(10,V),
V \= 0, !,
'$save_current_choice_point'(CP),
'$spied_call_depth_limited'(A,CP,D).
'$user_call_depth_limited'(A,D) :-
'$save_current_choice_point'(CP),
'$call_depth_limited'(A,CP,D).
'$call_depth_limited'(M:G,CP,D) :- !,
( '$current_module'(M) ->
'$check_callable'(G,M:G),
'$call_depth_limited'(G,CP,D)
;
'$current_module'(Old,M),
'$check_callable'(G,M:G),
( '$call_depth_limited'(G,CP,D); '$current_module'(_,Old), fail ),
( '$current_module'(_,Old); '$current_module'(_,M), fail)
).
'$call_depth_limited'(fail,_,_) :- !, fail.
'$call_depth_limited'(false,_,_) :- !, false.
'$call_depth_limited'(true,_,_) :- !.
'$call_depth_limited'(otherwise,_,_) :- !.
'$call_depth_limited'((A,B),CP,D) :- !,
'$check_callable'(A,(A,B)),
D1 is D+1,
'$call_depth_limited'(A,CP,D1),
'$check_callable'(B,(A,B)),
'$call_depth_limited'(B,CP,D1).
'$call_depth_limited'((X->Y),CP,D) :- !,
'$check_callable'(X,(X->Y)),
CP1 is local_sp,
D1 is D+1,
'$call_depth_limited'(X,CP,D1),
'$$cut_by'(CP1),
'$check_callable'(Y,(X->Y)),
'$call_depth_limited'(Y,CP,D1).
'$call_depth_limited'((X->Y; Z),CP,D) :- !,
'$check_callable'(X,(X->Y;Z)),
D1 is D+1,
(
'$call_depth_limited'(X,CP,D1), !,
'$check_callable'(Y,(X->Y;Z)),
'$call_depth_limited'(Y,CP,D1)
;
'$check_callable'(Z,(X->Y;Z)),
'$call_depth_limited'(Z,CP,D1)
).
'$call_depth_limited'((A;B),CP,D) :- !,
'$check_callable'(A,(A;B)),
D1 is D+1,
(
'$call_depth_limited'(A,CP,D1)
;
'$check_callable'(B,(A;B)),
'$call_depth_limited'(B,CP,D1)
).
'$call_depth_limited'((A|B),CP,D) :- !,
'$check_callable'(A,(A|B)),
D1 is D+1,
(
'$call_depth_limited'(A,CP,D1)
;
'$check_callable'(B,(A|B)),
'$call_depth_limited'(B,CP,D1)
).
'$call_depth_limited'(\+ X,CP,D) :- !,
'$check_callable'(X, \+ X),
\+ '$call_depth_limited'(X,CP,D).
'$call_depth_limited'(not X,CP,D) :- !,
'$check_callable'(X, not X),
\+ '$call_depth_limited'(X,CP,D).
'$call_depth_limited'(!,CP,_) :- $$cut_by(CP).
'$call_depth_limited'(repeat,_,_) :- !, $repeat.
'$call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
'$call_depth_limited'(A,CP,D) :-
( '$undefined'(A) ->
functor(A,F,N), $current_module(M),
( '$recorded'($import,$import(S,M,F,N),_) ->
'$call_depth_limited'(S:A,CP,D) ;
get_depth_limit(D0),
'$set_depth_limit'(D),
'$undefp'([M|A]),
'$set_depth_limit'(D0),
'$ensure_env_for_call_depth_limited'
)
;
get_depth_limit(D0),
'$set_depth_limit'(D),
'$execute0'(A),
'$set_depth_limit'(D0),
'$ensure_env_for_call_depth_limited'
).
'$spied_call_depth_limited'(M:G,CP,D) :- !,
( '$current_module'(M) ->
'$check_callable'(G,M:G),
'$spied_call_depth_limited'(G,CP,D)
;
'$current_module'(Old,M),
'$check_callable'(G,M:G),
( '$spied_call_depth_limited'(G,CP,D); '$current_module'(_,Old), fail ),
( '$current_module'(_,Old); '$current_module'(_,M), fail)
).
'$spied_call_depth_limited'(fail,_,_) :- !, fail.
'$spied_call_depth_limited'(false,_,_) :- !, false.
'$spied_call_depth_limited'(true,_,_) :- !.
'$spied_call_depth_limited'(otherwise,_,_) :- !.
'$spied_call_depth_limited'((A,B),CP,D) :- !,
'$check_callable'(A,(A,B)),
D1 is D+1,
'$spied_call_depth_limited'(A,CP,D1),
'$check_callable'(B,(A,B)),
'$spied_call_depth_limited'(B,CP,D1).
'$spied_call_depth_limited'((X->Y),CP,D) :- !,
'$check_callable'(X,(X->Y)),
CP1 is local_sp,
D1 is D+1,
'$spied_call_depth_limited'(X,CP,D1),
'$$cut_by'(CP1),
'$check_callable'(Y,(X->Y)),
'$spied_call_depth_limited'(Y,CP,D1).
'$spied_call_depth_limited'((X->Y; Z),CP, D) :- !,
'$check_callable'(X,(X->Y;Z)),
D1 is D+1,
(
'$spied_call_depth_limited'(X,CP,D1), !,
'$check_callable'(Y,(X->Y;Z)),
'$spied_call_depth_limited'(Y,CP,D1)
;
'$check_callable'(Z,(X->Y;Z)),
'$spied_call_depth_limited'(Z,CP,D1)
).
'$spied_call_depth_limited'((A;B),CP,D) :- !,
'$check_callable'(A,(A;B)),
D1 is D+1,
(
'$spied_call_depth_limited'(A,CP,D1)
;
'$check_callable'(B,(A;B)),
'$spied_call_depth_limited'(B,CP,D1)
).
'$spied_call_depth_limited'((A|B),CP,D) :- !,
'$check_callable'(A,(A|B)),
D1 is D+1,
(
'$spied_call_depth_limited'(A,CP,D1)
;
'$check_callable'(B,(A|B)),
'$spied_call_depth_limited'(B,CP,D1)
).
'$spied_call_depth_limited'(\+ X,CP,D) :- !,
'$check_callable'(X, \+ X),
\+ '$spied_call_depth_limited'(X,CP,D).
'$spied_call_depth_limited'(not X,CP,D) :- !,
'$check_callable'(X, not X),
\+ '$spied_call_depth_limited'(X,CP,D).
'$spied_call_depth_limited'(!,CP,_) :- $$cut_by(CP).
'$spied_call_depth_limited'(repeat,_,_) :- !, '$repeat'.
'$spied_call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
'$spied_call_depth_limited'(A,CP,D) :-
( '$undefined'(A) ->
functor(A,F,N), $current_module(M),
( '$recorded'($import,$import(S,M,F,N),_) ->
'$spied_call_depth_limited'(S:A,CP,D) ;
get_depth_limit(D0),
'$set_depth_limit'(D),
'$spy'(A),
'$set_depth_limit'(D0),
'$ensure_env_for_call_depth_limited'
)
;
get_depth_limit(D0),
'$set_depth_limit'(D),
'$spy'(A),
'$set_depth_limit'(D0),
'$ensure_env_for_call_depth_limited'
).
'$ensure_env_for_call_depth_limited'.