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). |