49
50:- module(tools_ecl). 51:- local chtab(0'`, string_quote), chtab(0'", list_quote).
52
53%% A - EXPORT ECLIPSE SPECIFIC TOOLS
54:- export
55 % 1 - SOCKETS
56 tcp_socket/1, % Compatibility with SWI
57 tcp_bind/2, % Compatibility with SWI
58 tcp_listen/2, % Compatibility with SWI
59 tcp_accept_socket/5, % Compatibility with SWI
60 % 2 - STRINGS
61 string_to_atom/2, % Compatibility with SWI
62 string_to_list/2, % Compatibility with SWI
63 string_to_term/2, % Compatibility with SWI
64 string_to_number/2,
65 % 3 - OS TOOLS
66 turn_on_gc/0,
67 turn_off_gc/0,
68 proc_exists/1,
69 proc_kill/1,
70 proc_wait/2,
71 file_exists/1,
72 gethostname/1, % Compatibility with SWI
73 call_to_exec/3,
74 time/1, % (Partial) compatibility with SWI
75 catch_fail/2,
76 catch_succ/2,
77 % 5 - CONSTRAINTS
78 indomain_rand/1,
79 % 6 - OTHER TOOLS
80 %catch/3, % RE-EXPORTED
81 %call_succ/2,
82 %call_fail/2,
83 %thhrow/1, % RE-EXPORTED
84 %multifile/1, % RE-EXPORTED
85 %assertz/1, % RE-EXPORTED
86 %retractall/1, % RE-EXPORTED
87 %shuffle/2,
88 term_to_atom/2,
89 atom_number/2, % Compatibulity with SWI
90 %number_chars/2, % RE-EXPORTED (iso)
91 %atom_chars/2, % RE-EXPORTED (iso)
92 tab/1,
93 wait_for_input/3, % Compatibility with SWI
94 get0/1,
95 random/3,
96 is_list/1, % Compatibility with SWI
97 last/2, % Compatibility with SWI
98 set_backquoted_string/0,
99 reset_backquoted_string/0,
100 style_check/1, % Compatibility with SWI
101 module/2. 102
107style_check(_).
108
110:- ensure_loaded(library(iso)). 111:- reexport catch/3, throw/1, multifile/1, sub_atom/5,
112 assertz/1, flush_output/0, atom_chars/2,
113 number_chars/2 from iso.
114:- import atom_chars/2, number_chars/2 from iso.
115
116
117% From QUINTUS
118%:- ensure_loaded(library(quintus)).
119:- reexport retractall/1 from quintus.
120
122:- ensure_loaded(library(lists)). 123:- reexport maplist/3, shuffle/2 from lists.
124
126:- ensure_loaded(library(apply)). 127:- reexport apply/2 from apply.
128
130:- ensure_loaded(library(cio)). 131:- reexport tell/1, telling/1, see/1, seeing/1, seen/0, told/0 from cio.
136:- include(common). 137:- export(extract_substring/6). 138:- export(any_to_number/2). 139:- export(any_to_string/2). 140:- export(lany_to_string/2). 141:- export(emptyString/1). 142:- export(build_string/2). 143:- export(string_replace/4). 144:- export(join_atom/3). 145:- export(split_atom/4).
146
147:- export(send_data_socket/2). 148:- export(receive_list_data_socket/2).
149:- export(receive_data_socket/2).
150
151:- export(report_message/2). 152:- export(set_debug_level/1). 153:- export(proc_term/1). 154:- export(catch_succ/2). 155:- export(catch_fail/2). 156:- export(get_argument/2).
157:- export(get_list_arguments/1). 158:- export(subv/4). 159:- export(sublist/2). 160:- export(get_integer/3). 161
167
169tcp_socket(S) :- socket(internet, stream, S).
170tcp_bind(S, P) :- bind(S, P).
171tcp_listen(S, N) :- listen(S,N).
172
173tcp_accept_socket(S, R, W, RHost, RPort) :-
174 accept(S, RHost/RPort, RW), R=RW, W=RW.
175tcp_accept_socket(S, R, W, RHost, RPort) :-
176 accept(S, RHost/RPort, RW), R=RW, W=RW.
177
178
184
186string_to_atom(S, A) :- string(S), atom_string(A, S).
187string_to_atom(A, A) :- atom(A).
188string_to_list(S, L) :- string_list(S, L).
189string_to_term(S, T) :- term_string(T, S).
190string_to_number(S, N) :- number_string(N, S).
191
192
198
200turn_on_gc :- set_flag(gc, on).
201turn_off_gc :- set_flag(gc, off).
202
203proc_exists(Pid) :- kill(Pid, 0).
204proc_kill(Pid) :- kill(Pid, 9).
205proc_wait(Pid, S) :- wait(Pid, S).
206file_exists(File) :- exists(File).
207
209gethostname(Host) :- get_flag(hostname, Host).
210
212call_to_exec(unix, Command, Command2) :-
213 concat_atom(['sh -c \"', Command, '\"'], Command2).
214
217:- tool(time/1, time/2). 218time(G,M) :- cputime(X1),
219 (call(once(G))@M ->
220 cputime(X2),
221 X3 is X2-X1,
222 time_mesg(I, X3)
223 ;
224 cputime(X2),
225 X3 is X2-X1,
226 time_mesg(I, X3),
227 fail
228 ).
229
230time_mesg(I, S) :-
231 write('% '),
232 write(I),
233 write(' inferences in '),
234 write(S),
235 write(' seconds'),
236 nl.
237
238
241:- tool(catch_fail/2, catch_fail/3). 242catch_fail(Call, Message, Module) :-
243 catch(Call,E,
244 (report_message(warning,[Message, ' ---> ', E]),
245 fail)
246 )@Module.
247:- tool(catch_succ/2, catch_succ/3). 248catch_succ(Call, Message, Module) :-
249 catch(Call,E,
250 (report_message(warning,[Message, ' ---> ', E]),
251 true)
252 )@Module.
253
260:- lib(fd). 261:- lib(fd_search). 262
263% Values for X are tried in a random order.
264% On backtracking, the previously tried value is removed.
265indomain_rand(X) :-
266 % Find out how many domain elements we have to choose from.
267 dvar_domain(X, Dom),
268 dom_size(Dom, Size),
269 % Get the domain elements.
270 X :: L,
271 % Choose one at random.
272 Index is 1 + (random mod Size),
273 nth_value(L, Index, Try),
274 % Try assigning it.
275 indomain_rand(X, Try).
276
277indomain_rand(X, X).
278indomain_rand(X, Try) :-
279 X #\= Try,
280 indomain_rand(X).
281
287
289tab(N):- N=<0.
290tab(N):- N>0, write('\t'), N2 is N-1, tab(N2).
291
294get0(X) :- get(input, X).
295
298wait_for_input(StreamList, ReadyList, 0) :- !,
299 select(StreamList, block, ReadyList).
300wait_for_input(StreamList, ReadyList, TimeOut) :-
301 select(StreamList, TimeOut, ReadyList).
302
304random(Lower, Upper, N) :-
305 N is Lower + (random mod Upper).
306
308is_list(L):- functor(L,'.',_).
309
311last(Last,[Head|Tail]) :-
312 last_1(Tail, Head, Last).
313last_1([],Last,Last).
314last_1([Head|Tail], _, Last) :-
315 last_1(Tail, Head, Last).
316
318term_to_atom(T, A) :- ground(T), term_string(T, S), atom_string(A, S).
319term_to_atom(T, A) :- ground(A), atom_string(A, S), term_string(T, S).
320
322atom_number(A, N) :- ground(A), !, atom_chars(A, C), number_chars(N,C).
323atom_number(A, N) :- ground(N), atom_chars(A, C), number_chars(N,C).
324
326module(Name, LExports) :- create_module(Name),
327 export_list(LExports).
328export_list([]).
329export_list([P|L]) :- export P, export_list(L).
330
332:- tool(set_backquoted_string/0, set_backquoted_string/1). 333set_backquoted_string(M) :- call(set_chtab(0'`, string_quote))@M,
334 call(set_chtab(0'", list_quote))@M.
335:- tool(reset_backquoted_string/0, reset_backquoted_string/1). 336reset_backquoted_string(M) :- call(set_chtab(0'", string_quote))@M,
337 call(set_chtab(0'`, list_quote))@M.
338