2:- module(frames,
3 [ current_frames/4,
4 current_next_frames/4,
5 in_pengines/0,
6 find_parent_frame_attribute/5,
7 parent_goal/2,
8 parent_goal/1,
9 prolog_frame_match/3,
10 relative_frame/3,
11 stack_check/0,
12 stack_check/1,
13 stack_check/2,
14 stack_check_else/2,
15 stack_check_or_call/2,
16 stack_depth/1
17 ]). 18:- module_transparent
19 current_frames/4,
20 current_next_frames/4,
21 in_pengines/0,
22 find_parent_frame_attribute/5,
23 parent_goal/2,
24 parent_goal/1,
25 prolog_frame_match/3,
26 relative_frame/3,
27 stack_check/0,
28 stack_check/1,
29 stack_check/2,
30 stack_check_else/2,
31 stack_check_or_call/2,
32 stack_depth/1. 33
34:- set_module(class(library)). 35
36
37
44
51stack_depth(Level):-quietly((prolog_current_frame(Frame),prolog_frame_attribute(Frame,level,Level))).
52
53
54:- module_transparent stack_check/0. 55:- module_transparent stack_check/1.
61stack_check:- sanity(stack_check(6606)).
62
69stack_check(BreakIfOver):- stack_check_else(BreakIfOver, (ds,trace,break,trace_or_throw(stack_check(BreakIfOver)))).
70
77stack_check(BreakIfOver,Error):- stack_check_else(BreakIfOver, trace_or_throw(stack_check(BreakIfOver,Error))).
78
85stack_check_else(BreakIfOver,Call):- stack_depth(Level) , ( Level < BreakIfOver -> true ; (dbgsubst(Call,stack_lvl,Level,NewCall),NewCall)).
86
87stack_check_or_call(BreakIfOver,Call):- stack_depth(Level) , ( Level < BreakIfOver -> true ; call(Call)).
88
89
90
97in_pengines:- zotrace(relative_frame(context_module,pengines,_)).
98
100:- export(relative_frame/3). 101
108relative_frame(Attrib,Term,Nth):- find_parent_frame_attribute(Attrib,Term,Nth,_RealNth,_FrameNum).
109
110
111
119:- export(parent_goal/1). 120parent_goal(Goal):- nonvar(Goal), quietly((prolog_current_frame(Frame),prolog_frame_attribute(Frame,parent,PFrame),
121 prolog_frame_attribute(PFrame,parent_goal,Goal))).
122parent_goal(Goal):- !, quietly((prolog_current_frame(Frame),prolog_frame_attribute(Frame,parent,PFrame0),
123 prolog_frame_attribute(PFrame0,parent,PFrame),
124 goals_above(PFrame,Goal))).
125
126goals_above(Frame,Goal):- prolog_frame_attribute(Frame,goal,Term),unify_goals(Goal,Term).
127goals_above(Frame,Goal):- prolog_frame_attribute(Frame,parent,PFrame), goals_above(PFrame,Goal).
128
129unify_goals(Goal,Term):- (var(Goal);var(Term)),!,Term=Goal.
130unify_goals(M:Goal,N:Term):-!, unify_goals0(Goal,Term),M=N.
131unify_goals(Goal,_:Term):-!, unify_goals0(Goal,Term).
132unify_goals(_:Goal,Term):-!, unify_goals0(Goal,Term).
133
134unify_goals0(X,X).
135
142parent_goal(Goal,Nth):- number(Nth),!, prolog_current_frame(Frame),prolog_frame_attribute(Frame,parent,PFrame),nth_parent_goal(PFrame,Goal,Nth).
143parent_goal(Goal,Nth):- find_parent_frame_attribute(goal,Goal,Nth,_RealNth,_FrameNum).
144
145
152nth_parent_goal(Frame,Goal,Nth):- Nth>0, Nth2 is Nth-1, prolog_frame_attribute(Frame,parent,PFrame),!,zotrace((nth_parent_goal(PFrame,Goal,Nth2))).
153nth_parent_goal(Frame,Goal,_):- zotrace((prolog_frame_attribute(Frame,goal,Goal))),!.
154
155:- export(find_parent_frame_attribute/5). 156
163find_parent_frame_attribute(Attrib,Term,Nth,RealNth,FrameNum):-quietly((ignore(Attrib=goal),prolog_current_frame(Frame),
164 current_frames(Frame,Attrib,5,NextList))),!,
165 catch(nth1(Nth,NextList,Out),E,(wdmsg(E),trace,nth1(Nth,NextList,Out))),
166 Out = RealNth-FrameNum-Term.
167
168
169
176prolog_frame_match(Frame,goal,Term):-!,prolog_frame_attribute(Frame,goal,TermO),!,Term=TermO.
177prolog_frame_match(Frame,parent_goal,Term):-nonvar(Term),!,prolog_frame_attribute(Frame,parent_goal,Term).
178prolog_frame_match(Frame,not(Attrib),Term):-!,nonvar(Attrib),not(prolog_frame_attribute(Frame,Attrib,Term)).
179prolog_frame_match(_,[],X):-!,X=[].
180prolog_frame_match(Frame,[I|IL],[O|OL]):-!,prolog_frame_match(Frame,I,O),!,prolog_frame_match(Frame,IL,OL),!.
181prolog_frame_match(Frame,Attrib,Term):-prolog_frame_attribute(Frame,Attrib,Term).
182
183
190current_frames(Frame,Attrib,N,NextList):- notrace(current_frames0(Frame,Attrib,N,NextList)).
191current_frames0(Frame,Attrib,N,NextList):- N>0, N2 is N-1,prolog_frame_attribute(Frame,parent,ParentFrame),!,current_frames0(ParentFrame,Attrib,N2,NextList).
192current_frames0(Frame,Attrib,0,NextList):- current_next_frames(Attrib,1,Frame,NextList).
193
194
201current_next_frames(Attrib,Nth,Frame,[Nth-Frame-Term|NextList]):- zotrace((prolog_frame_match(Frame,Attrib,Term))), !,
202 (prolog_frame_attribute(Frame,parent,ParentFrame) ->
203 ( Nth2 is Nth+1, current_next_frames(Attrib,Nth2, ParentFrame,NextList));
204 NextList=[]).
205current_next_frames(Attrib,Nth,Frame,NextList):-
206 (prolog_frame_attribute(Frame,parent,ParentFrame) ->
207 ( Nth2 is Nth+1, current_next_frames(Attrib,Nth2, ParentFrame,NextList));
208 NextList=[]).
209current_next_frames(_,_,_,[]).
210
211
212
213:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)),
214 forall(source_file(M:H,S),
215 ignore((functor(H,F,A),
216 ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))),
217 ignore(((\+ predicate_property(M:H,transparent), module_transparent(M:F/A), \+ atom_concat('__aux',_,F),debug(modules,'~N:- module_transparent((~q)/~q).~n',[F,A]))))))))).