1 % (c) 2009-2019 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 :- module(tools_meta,[safe_time_out/3,
6 safe_time_out_or_virtual_time_out/3,
7 call_residue/2,
8 safe_on_exception/3, safe_on_exception_silent/3,
9 reraise_important_exception/1,
10 det_call_cleanup/2,
11 frozen_member/2,
12 catch_matching/3,
13 safe_numbervars/3,
14 translate_term_into_atom/2,
15 translate_term_into_atom_with_max_depth/2, translate_term_into_atom_with_max_depth/3
16 ]).
17
18 :- use_module(module_information).
19
20 :- module_info(group,infrastructure).
21 :- module_info(description,'A utility on timeouts safe_time_out seperated out from tools.pl to avoid cyclic module dependencies.').
22
23 :- use_module(library(timeout),[time_out/3]).
24 :- meta_predicate safe_time_out(0,*,*).
25 safe_time_out(Call,TO,Res) :-
26 ? (TO >= 2147483646
27 -> (TO = 2147483646 -> true % special value to turn time_out off (set by -disable_time_out); time_out has an overhead
28 ; print('### Warning: TIME_OUT value too high (>2147483646): '), print(TO),nl,
29 print('### Calling goal without TIME_OUT (use 2147483646 to turn TIME_OUT off silently)'),nl),
30 call(Call), Res=success
31 ? ; TO < 1 -> print('### Warning: TIME_OUT value too small: '), print(TO),nl,
32 time_out(Call,1,Res)
33 ? ; time_out(Call,TO,Res)).
34
35 :- meta_predicate safe_time_out_or_virtual_time_out(0,*,*).
36 % catches virtual-time_out exceptions and returns them as normal time_out result
37 safe_time_out_or_virtual_time_out(Call,TO,Res) :-
38 on_exception(enumeration_warning(_,_,_,_,_),safe_time_out(Call,TO,Res),Res=time_out).
39
40 /* from File: sp4_compatibility_mappings.pl */
41 /* Created: 08/05/2007 by Michael Leuschel */
42
43 :- meta_predicate call_residue(0,*).
44
45 ?call_residue(X,Residue) :- call_residue_vars(X,V),filter_residue_vars(V,Residue).
46
47
48 filter_residue_vars([],[]).
49 filter_residue_vars([H|T],Res) :-
50 frozen(H,FH),
51 (FH=true -> Res=RT ; Res = [FH|RT]),
52 filter_residue_vars(T,RT).
53
54 % --------------------------
55
56 :- meta_predicate safe_on_exception(*,0,0).
57 % use if you want to catch any exception; ensures time_out not treated and passed on
58 safe_on_exception(E,Call,ExcCode) :-
59 on_exception(E,call(Call), (print(exception(E)),nl,
60 reraise_important_exception(E),ExcCode)).
61 :- meta_predicate safe_on_exception_silent(*,0,0).
62 safe_on_exception_silent(E,Call,ExcCode) :-
63 on_exception(E,call(Call), (reraise_important_exception(E),ExcCode)).
64
65 % reraise important exceptions
66 reraise_important_exception(time_out) :- !, raise_exception(time_out).
67 reraise_important_exception(_).
68
69 % --------------------------
70
71
72 :- meta_predicate det_call_cleanup(0,0).
73 % a simplified version of call_cleanup; only really works for deterministic predicates
74 % or if it is ok to call CleanUpCall multiple times on success of Call
75 % is much faster, as call_cleanup has an overhead of about 300 Prolog instructions
76 % but this seems even slower ?? add_transitions__with_timeout_fail_loop
77
78 det_call_cleanup(Call,CleanUpCall) :-
79 on_exception(E,
80 if(Call,CleanUpCall,CleanUpCall),
81 (CleanUpCall,throw(E))).
82
83 % --------------------------
84
85 %:- meta_predicate frozen_member(*,0). % without meta_predicate we can call frozen_member with a variable for Goal
86 % check if Goal is attached as a pending co-routine to Var
87 frozen_member(Var,Goal) :- var(Var), frozen(Var,Frozen),
88 frozen_mem_aux(Frozen,Goal).
89
90 frozen_mem_aux((A,B),Goal) :- !, (frozen_mem_aux(A,Goal) ; frozen_mem_aux(B,Goal)).
91 frozen_mem_aux(Goal,Goal).
92
93
94 % --------------------------
95
96 % like catch/3, but it does not fail if an exception occurs that is not
97 % unifiable with the second argument. Instead it re-throws the original
98 % exception.
99 :- meta_predicate catch_matching(0,*,0).
100 catch_matching(Call,Exception,Handler) :-
101 catch(Call, E, (E=Exception -> Handler ; throw(E))).
102
103 % --------------------------
104
105 safe_numbervars(Term,Start,End) :-
106 on_exception(E,numbervars(Term,Start,End),
107 (print('Exception during numbervars: '),print(E),nl,nl,reraise_important_exception(E))).
108
109 % --------------------------
110
111
112 :- use_module(library(codesio), [write_term_to_codes/3]).
113 translate_term_into_atom(CTerm,Atom) :-
114 copy_term(CTerm,Term), safe_numbervars(Term,0,_),
115 write_term_to_codes(Term,Temp,[quoted(true),numbervars(true)]),
116 atom_codes(Atom,Temp).
117 translate_term_into_atom_with_max_depth(Term,Atom) :-
118 translate_term_into_atom_with_max_depth(Term,20,Atom).
119 translate_term_into_atom_with_max_depth(Term,_,Atom) :- atomic(Term),!,Atom=Term.
120 translate_term_into_atom_with_max_depth(Term,Limit,Atom) :-
121 write_term_to_codes(Term,Temp,[quoted(true),numbervars(true),max_depth(Limit)]),
122 atom_codes(Atom,Temp).