1		% (c) 2009-2025 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
6		:- module(tools, [exact_member/2,
7		exact_member_lookup/4, exact_member_replace/5,
8		remove/3, remove_all/3, insert/3,
9		remove_variables/3,
10		list_intersection/3, list_difference/3,
11		disjoint_list_union/3, lists_are_disjoint/2,
12		string_concatenate/3, is_upper_case_name/1,
13		%write_to_file/2, write_to_utf8_file/2, put_codes/2, % now in tools_files
14		%print_error/1,
15		print_message/1, print_message_with_max_depth/2,
16		print_short_msg/1,
17		print_bt_message/1, print_bt_trace_message/1, bt_trace/1,
18		format_bt/2,
19		print_wtime/1,
20		print_mb/1, print_gb/1,
21		prints/1,
22		is_absolute_path/1,
23		split_common_path/4,
24		gen_relative_path/3, gen_relative_path_to_cur_dir/2,
25		get_parent_directory/2, get_parent_directory_name/2,
26		get_parent_directory_of_directory/2,
27		get_tail_filename/2, get_modulename_filename/2,
28		get_filename_extension/2,
29		get_option_from_list/4, get_options_from_list/2,
30		get_options/4,get_options/5,
31		arg_is_number/2, arg_is_number_or_wildcard/2,
32		check_filename_arg/2,
33		arg_is_integer/2,
34		split_filename/3,
35		safe_absolute_file_name/2, safe_absolute_file_name/3,
36		host_file_name_case_insensitive/0,
37		same_file_name/2,
38
39		filter/4,
40		flatten/2,
41		% count_occurences/2, % now in tools_lists
42		split_last/4,
43		split_atom/3, split_chars/3, split_complex_sep/3,
44		latex_escape_atom/2,
45		b_escape_string_atom/2, b_string_escape_codes/2,
46		string_escape/2, print_escaped/1, % can also be used for dot
47		simple_dot_string_escape/2, % for dot, just quoting "
48		html_escape/2, html_escape_codes/2,
49		xml_attribute_escape/2,
50		read_term_from_file/2,
51		safe_read_term_from_atom/2, safe_read_term_from_codes/2,
52		read_string_from_file/2, read_string_from_file/3,
53		safe_read_string_from_file/3,
54		read_atom_from_file/3,
55		% write_lines_to_file/2, % now in tools_files
56		open_temp_file/3,
57		open_temp_file/4,
58		detect_xml_encoding/3,
59
60		ajoin/2,
61		ajoin_with_limit/3,
62		ajoin_with_sep/3,
63		substitute/4,
64		% call_residue/2, % now in tools_meta
65
66		catch_call/1,
67		observe_user_interrupt_signal/3,
68		%safe_on_exception/3, safe_on_exception_silent/3, % now in tools_meta
69		%reraise_important_exception/1, % now in tools_meta
70		% catch_matching/3, % now in tools_meta
71
72		convert_list_into_pairs/2, convert_pairs_into_list/3,
73
74		safe_univ/2, safe_univ_no_cutoff/2,
75		safe_sort/3,
76		safe_set_sort/3,
77		safe_functor/4,
78
79		safe_atom_codes/2, safe_atom_chars/3,
80		atom_codes_with_limit/2, atom_codes_with_limit/3,
81		truncate_atom/3, wrap_and_truncate_atom/4,
82		safe_number_codes/2,
83		atom_or_number_codes/2,
84		ensure_atom/2,
85		number_suffix/3,
86
87		print_size_of_table/1,
88		print_runtime/0, start_ms_timer/1, stop_ms_timer/2, stop_ms_timer/1,
89		stop_ms_timer_with_msg/2, stop_ms_timer_with_debug_msg/2,
90		stop_ms_walltimer_with_msg/2,
91		bt_start_ms_timer/1, bt_stop_ms_timer/1,
92		get_elapsed_walltime/2,
93		get_elapsed_timer/2, combiner_timer/3,
94		get_elapsed_runtime/2,
95		cputime/1, walltime/1,
96		convert_ms_time_to_string/2,
97
98		retract_with_statistics/2,
99		statistics_memory_used/1,
100		get_memory_used/1, print_memory_used_difference/2, print_memory_used/1,
101		print_memory_used_wo_gc/0, print_memory_used_wo_gc/1,
102
103		split_list/4,
104		split_list_idx/5, re_split_list_idx/4,
105
106		minimize_lasso/4,
107
108		map_split_list/4,
109		foldl/4,foldl/5,foldl/6,
110		maplist5/5,
111		average/2,
112
113		map_optlist/2,
114		optlist_to_list/2,
115
116		(space_call)/1,
117		assert_once/1,
118
119		% safe_time_out/3, % now in tools_meta
120		% time_out_call/2, time_out_call/1, time_out_with_factor_call/3, % now in tools_timeout
121
122		unique_id/2,
123
124		get_PROBPATH/1,
125		atom_to_number/2,
126		get_set_optional_prolog_flag/3,
127
128		bb_safe_get/2,
129		bb_inc/1, bb_inc_by/2
130		]).
131
132		:- meta_predicate foldl(3,?,?,?).
133		:- meta_predicate foldl2(?,3,?,?).
134		:- meta_predicate foldl(4,?,?,?,?).
135		:- meta_predicate foldl2(?,4,?,?,?).
136		:- meta_predicate foldl(5,?,?,?,?,?).
137		:- meta_predicate foldl2(?,5,?,?,?,?).
138		:- meta_predicate maplist5(4,-,-,-,-).
139		:- meta_predicate catch_call(0).
140		:- meta_predicate assert_once(0).
141		:- meta_predicate split_list_idx(1,?,?,?,?).
142		:- meta_predicate split_list_idx2(?,1,?,?,?).
143		:- meta_predicate map_split_list(2,?,?,?).
144		:- meta_predicate map_split_list2(?,2,?,?).
145		:- meta_predicate split_list(1,?,?,?).
146		:- meta_predicate split_list2(?,1,?,?).
147		:- meta_predicate observe_user_interrupt_signal(-,-,0).
148		:- meta_predicate filter(1,*,*,*).
149		:- meta_predicate get_options(+,4,-,-).
150		:- meta_predicate get_options(+,4,-,-,0).
151		:- meta_predicate retract_all_count(0,-,-).
152		:- meta_predicate space_call(0).
153		:- meta_predicate map_optlist(1,-).
154		:- meta_predicate map_optlist_aux(-,1).
155		:- meta_predicate call_optional(1,-).
156		:- meta_predicate call_optional_aux(-,1,-).
157
158		:- meta_predicate get_calls_for_table(:,-).
159		:- meta_predicate print_size_of_table(:).
160
161		:- meta_predicate string_escape(2,-,-).
162
163		:- meta_predicate bb_safe_get(0,-).
164		:- meta_predicate bb_inc(0).
165		:- meta_predicate bb_inc_by(0,-).
166
167		:- use_module(module_information).
168
169		:- module_info(group,infrastructure).
170		:- module_info(description,'This module contains many general helper predicates.').
171
172		:- use_module(pathes,[runtime_application_path/1]). % we just import it to set-up pathes, we don't need any predicates
173
174		:- use_module(library(lists)).
175		:- use_module(library(system)).
176		%%:- use_module(library(file_systems)). %% not required ?
177		%% :- use_module(library(codesio)).
178
179
180		:- use_module(tools_meta,[reraise_important_exception/1, safe_on_exception/3]).
181
182		:- set_prolog_flag(double_quotes, codes).
183
184
185		catch_call(Call) :-
186		catch(call(Call), Exception, (
187		add_error(catch_call,'Call raised an exception: ',(Call:Exception)),
188		/* read(_), */
189		reraise_important_exception(Exception),
190		fail
191		)).
192
193		:- use_module(error_manager,[add_warning/4]).
194		% catch CTRL-C and print a message if it happens and re-throw the interrupt
195		observe_user_interrupt_signal(Context,Span,Call) :-
196		catch(Call, user_interrupt_signal, (
197		add_warning(user_interrupt_signal,'CTRL-C occurred in context: ',Context,Span),
198		%(pending_abort_error(WF,Msg,_ErrTerm,Span)
199		% % Unfortunately any abort errors induced by Call itself are already removed by the exception
200		% -> add_message(user,'Pending WD-Error could cause long runtimes: ',Msg,Span) ; true),
201		throw(user_interrupt_signal)
202		)).
203
204
205
206		:- use_module(self_check). % put after search paths have been set
207
208		% These predicates from tools_platform are tested here to avoid module load order issues.
209
210		:- use_module(tools_platform, [map_host_platform/2, map_host_processor/2, host_platform/1]).
211		:- assert_must_succeed(map_host_platform("x86-win32-nt-4",windows)).
212		:- assert_must_succeed(map_host_platform("x86_64-win32-nt-4",windows)).
213		:- assert_must_succeed(map_host_platform("x86_64-darwin-10.6.0",darwin)).
214		:- assert_must_succeed(map_host_platform("x86_64-darwin-18.7.0",darwin)).
215		:- assert_must_succeed(map_host_platform("arm64-darwin-20.1.0",darwin)).
216		:- assert_must_succeed(map_host_platform("x86-linux-glibc2.7",linux)).
217		:- assert_must_succeed(map_host_platform("x86_64-linux-glibc2.17",linux)).
218		:- assert_must_succeed(map_host_platform("aarch64-linux-glibc2.28",linux)).
219		:- assert_must_succeed(map_host_platform("nonsense-potatos-4.2",unknown)).
220		% On SWI, the arch/host_type flag doesn't include an OS version number.
221		:- assert_must_succeed(map_host_platform("i386-win32",windows)).
222		:- assert_must_succeed(map_host_platform("x64-win64",windows)).
223		:- assert_must_succeed(map_host_platform("x86_64-darwin",darwin)).
224		:- assert_must_succeed(map_host_platform("arm64-darwin",darwin)).
225		:- assert_must_succeed(map_host_platform("aarch64-linux",linux)).
226		:- assert_must_succeed(map_host_platform("nonsense-potatos",unknown)).
227
228		:- assert_must_succeed((host_platform(Platform), Platform \= unknown)).
229
230
231		:- assert_must_succeed(map_host_processor("x86-win32-nt-4",x86)).
232		:- assert_must_succeed(map_host_processor("x86_64-win32-nt-4",x86_64)).
233		:- assert_must_succeed(map_host_processor("x86_64-darwin-10.6.0",x86_64)).
234		:- assert_must_succeed(map_host_processor("x86_64-darwin-18.7.0",x86_64)).
235		:- assert_must_succeed(map_host_processor("arm64-darwin-20.1.0",aarch64)).
236		:- assert_must_succeed(map_host_processor("x86-linux-glibc2.7",x86)).
237		:- assert_must_succeed(map_host_processor("x86_64-linux-glibc2.17",x86_64)).
238		:- assert_must_succeed(map_host_processor("aarch64-linux-glibc2.28",aarch64)).
239		:- assert_must_succeed(map_host_processor("nonsense-potatos-4.2",unknown)).
240		% On SWI, the arch/host_type flag doesn't include an OS version number.
241		:- assert_must_succeed(map_host_processor("i386-win32",x86)).
242		:- assert_must_succeed(map_host_processor("x64-win64",x86_64)).
243		:- assert_must_succeed(map_host_processor("x86_64-darwin",x86_64)).
244		:- assert_must_succeed(map_host_processor("arm64-darwin",aarch64)).
245		:- assert_must_succeed(map_host_processor("aarch64-linux",aarch64)).
246		:- assert_must_succeed(map_host_processor("nonsense-potatos",unknown)).
247
248		% --------------------------------------
249
250		cputime(T) :-
251		statistics(runtime,[T,_]).
252
253		walltime(WT) :-
254		statistics(walltime,[WT,_]).
255		% --------------------------------------
256
257
258		:- use_module(error_manager,[add_error/3, add_internal_error/2]).
259		print_message(Msg) :- print_message_with_max_depth(Msg,20).
260		print_message_with_max_depth(Msg,MaxDepth) :-
261		safe_on_exception(E,print_message2(Msg,MaxDepth),
262		add_error(tools,'Exception in print_message: ',E)). % added because sometimes in Windows/Vista we get an exception here
263		print_message2(Msg,MaxDepth) :-
264		(var(Msg) -> print_message(informational,'_')
265		; write(user_output,'% '),write_term(user_output,Msg,[max_depth(MaxDepth)]),nl(user_output) ).
266		print_short_msg(Msg) :-
267		write(user_output,Msg).
268
269		format_bt(Msg,P) :- format(Msg,P).
270		format_bt(Msg,P) :- print(' * BACKTRACK: '),format(Msg,P),
271		fail.
272
273		print_bt_message(Msg) :- print_message(Msg).
274		print_bt_message(Msg) :- print_message(backtrack(Msg)),
275		%(Msg = found_enumeration_of_constants(_,_) -> trace ; true),
276		fail.
277
278		% like print_bt_message but trace upon backtrack
279		print_bt_trace_message(Msg) :- print_message(Msg).
280		print_bt_trace_message(Msg) :- trace,
281		print_message(backtrack(Msg)),
282		fail.
283
284		% trace upon backtrack:
285		bt_trace(_) :- true.
286		bt_trace(PP) :- print(' * BACKTRACK: '), print(PP),nl, trace,fail.
287
288		print_wtime(PP) :- statistics(walltime,[WT,_]),
289		format('~w : ~w ms ~n', [PP,WT]).
290
291		% a print that will automatically stop after 25 prints and give the user the option to inspect the printed messages
292		:- dynamic prints_count/1.
293		prints_count(25).
294		prints(L) :- print_bt_message(L),
295		(retract(prints_count(X)) -> true ; X=25),
296		(X<1
297		-> print('*** Stopped printing >'),
298		read(RT),
299		(number(RT) -> X1=RT ; X1=25)
300		; X1 is X-1
301		), assertz(prints_count(X1)).
302
303		:- assert_pre(tools:exact_member(_Var,Vs),
304		(list_skeleton(Vs))).
305		:- assert_post(tools:exact_member(_Var,_Vs), true).
306		:- assert_must_succeed(tools:exact_member(V,[V])).
307		:- assert_must_succeed(tools:exact_member(V,[_X,_Z,V])).
308		:- assert_must_fail(tools:exact_member(_W,[_X,_Z,_V])).
309		:- assert_must_fail(tools:exact_member(_W,[])).
310
311		exact_member(X,[Y|T]) :-
312		(X==Y -> true ; exact_member(X,T)).
313
314
315		:- assert_pre(tools:exact_member_lookup(_Var,_ValRes,Vs,Vals),
316		(list_skeleton(Vs),list_skeleton(Vals))).
317		:- assert_post(tools:exact_member_lookup(_Var,_ValRes,_Vs,_Vals), true).
318		:- assert_must_succeed(tools:exact_member_lookup(V,2,[V],[2])).
319		:- assert_must_succeed(tools:exact_member_lookup(V,2,[_X,_Z,V],[1,3,2])).
320		:- assert_must_fail(tools:exact_member_lookup(V,3,[_X,_Z,V],[1,3,2])).
321		:- assert_must_fail(tools:exact_member_lookup(_W,3,[_X,_Z,_V],[1,3,2])).
322		:- assert_must_fail(tools:exact_member_lookup(_W,3,[],[1,3,2])).
323
324		exact_member_lookup(Var,ValRes,[V|TV],[Val|TVal]) :-
325		(Var==V -> ValRes=Val ; exact_member_lookup(Var,ValRes,TV,TVal)).
326
327
328		:- assert_pre(tools:exact_member_replace(_Var,_ValRes,Vs,Vals,_),
329		(list_skeleton(Vs),list_skeleton(Vals))).
330		:- assert_post(tools:exact_member_replace(_Var,_ValRes,_Vs,_Vals,NewVals),
331		list_skeleton(NewVals)).
332		:- assert_must_succeed(tools:exact_member_replace(V,44,[_X,_Z,V],[1,3,2],[1,3,44])).
333		:- assert_must_fail(tools:exact_member_replace(_V,44,[_X,_Z,_VV],[1,3,2],[1,3,44])).
334
335		exact_member_replace(Var,NewVal,[V|TV],[Val|TVal],[NV|TN]) :-
336		((Var==V) -> (NV=NewVal,TN=TVal)
337		; (NV=Val,exact_member_replace(Var,NewVal,TV,TVal,TN))).
338
339
340
341		remove([X|T],X,T).
342	?	remove([Y|T],X,[Y|DT]) :- \+(X=Y), remove(T,X,DT).
343
344		:- assert_must_succeed(tools:flatten([],[])).
345		:- assert_must_succeed(tools:flatten([[1,2,3]],[1,2,3])).
346		:- assert_must_succeed(tools:flatten([[1],[[99]],[2,3],[4,5]],[1,99,2,3,4,5])).
347		:- assert_must_succeed(tools:flatten([[]],[])).
348
349		flatten(List,FlatList) :- flatten1(List,[],FlatList).
350		flatten1([],L,L) :- !.
351		flatten1([H|T],Tail,List) :- !, flatten1(H,FlatList,List), flatten1(T,Tail,FlatList).
352		flatten1(NonList,Tail,[NonList|Tail]).
353
354
355		:- use_module(tools_lists,[count_occurences/2]).
356		:- assert_must_succeed((tools_lists:count_occurences([a,b,a,a,b],R),R == [a-3,b-2])).
357
358
359
360		:- assert_must_succeed((tools:filter(var,[1,2,X,3,Y],R,Out),R == [X,Y],Out == [1,2,3])).
361		:- assert_must_succeed((tools:filter(nonvar,[1,2,X,3,Y],R,Out),R == [1,2,3],Out == [X,Y])).
362
363		filter(_Pred,[],[],[]).
364		filter(Pred,[H|T],True,False) :-
365	?	(call(Pred,H) -> True = [H|TT], filter(Pred,T,TT,False)
366	?	; False = [H|FF], filter(Pred,T,True,FF)).
367
368		:- public is_a_comment/3. % used for testing filter
369		:- assert_must_succeed((tools: filter(tools:is_a_comment('/*','*/'),['This comment ','/* comment */','will be ignored!'],R,Out),
370		R==['/* comment */'],Out==['This comment ','will be ignored!'])).
371		% checking whether an atom is a comment /* ... */
372		is_a_comment(Begin,End,Comment) :-
373		maplist(atom_codes,[Begin,End,Comment],[BL,EL,CL]),
374	?	prefix(CL,BL),suffix(CL,EL).
375
376		:- assert_must_succeed((tools:remove_variables([X,Y,Z],[Y],R),R==[X,Z])).
377		remove_variables(List,Vars,Remaining) :-
378		exclude(exact_member_rev(Vars),List,Remaining).
379		% a version of exact member with reversed parameters - usefull with
380		% higher-order functions
381		exact_member_rev(List,Member) :- exact_member(Member,List).
382
383		:- assert_must_succeed(tools:insert([],a,[a])).
384		:- assert_must_succeed(tools:insert([a,b,c,d],a,[a,b,c,d])).
385		:- assert_must_succeed(tools:insert([a,b,c,d],b,[a,b,c,d])).
386		:- assert_must_succeed(tools:insert([a,b,c,d],d,[a,b,c,d])).
387		:- assert_must_succeed(tools:insert([a,b,c,d],x,[a,b,c,d,x])).
388		insert([],X,[X]).
389		insert([H|T],X,R) :- (H=X -> R=[H|T] ; R=[H|R2],insert(T,X,R2)).
390
391
392		:- assert_must_succeed(tools:list_intersection([a,b,c,d],[d,f,b],[b,d])).
393
394		list_intersection([],_L,[]).
395		list_intersection([H|T],L,Res) :-
396	?	(remove(L,H,NL) -> (Res=[H|RR]) ; (Res=RR,NL=L)),
397		list_intersection(T,NL,RR).
398
399		insert_new([],X,[X]).
400		insert_new([H|T],X,R) :- (H=X -> fail ; R=[H|R2],insert_new(T,X,R2)).
401
402		:- assert_must_succeed(tools:disjoint_list_union([a,b,c,d],[e,f,g],[e,f,g,a,b,c,d])).
403		:- assert_must_fail(tools:disjoint_list_union([a,b,c,d],[d,f,b],_)).
404		:- assert_must_fail(tools:disjoint_list_union([a,b,c,d],[d,f,b],[d,f,b,a,c])).
405		disjoint_list_union([],L,L).
406		disjoint_list_union([H|T],L,Res) :- insert_new(L,H,L2), disjoint_list_union(T,L2,Res).
407
408		:- assert_must_succeed(tools:lists_are_disjoint([a,b,c,d],[e,f,g])).
409		:- assert_must_succeed(tools:lists_are_disjoint([a,b,c,d],[])).
410		:- assert_must_succeed(tools:lists_are_disjoint([],[e,f,g])).
411		:- assert_must_fail(tools:lists_are_disjoint([a,b,c,d],[e,f,g,d])).
412		lists_are_disjoint([],_).
413		lists_are_disjoint([H|T],List2) :- \+ member(H,List2), lists_are_disjoint(T,List2).
414
415		:- assert_must_succeed(tools:list_difference([a,b,c,d],[b,f,d],[a,c])).
416
417		list_difference([],_L,[]).
418		list_difference([H|T],L,Res) :-
419	?	(remove(L,H,NL) -> (Res=RR) ; (Res=[H|RR],NL=L)),
420		list_difference(T,NL,RR).
421
422		:- use_module(tools_strings,[string_concatenate/3]).
423		:- assert_must_succeed(( tools_strings:string_concatenate('5','.10',R), R=='5.10' )).
424
425
426
427
428		:- assert_must_succeed(tools:is_upper_case_name('GOODS')).
429		:- assert_must_succeed(tools:is_upper_case_name('ZZAA')).
430		:- assert_must_fail(tools:is_upper_case_name('capacity')).
431		:- assert_must_fail(tools:is_upper_case_name('PARAs')).
432
433		:- use_module(tools_strings,[safe_name/2]).
434		is_upper_case_name(Name) :-
435		safe_name(Name,AsciiList),
436		upper_case_list(AsciiList).
437
438		upper_case_list([]).
439		upper_case_list([H|T]) :- 0'A =< H, H =< 0'Z, upper_case_list(T).
440
441
442		:- assert_must_succeed(tools:split_common_path('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/','/aaaa/bbb/cc','d.app')).
443		:- assert_must_succeed(tools:split_common_path('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/e','/aaaa/bbb/cc','d.app')).
444		:- assert_must_succeed(tools:split_common_path('/aaaa/bbb/cc/d.app','/aaaa/bbb/ce/e','/aaaa/bbb','cc/d.app')).
445		:- assert_must_succeed(tools:split_common_path('/aaaa/bbb/cc/d.app','/aaaa/e','/aaaa','bbb/cc/d.app')).
446		split_common_path(Path1,Path2,CommonPrefix,Suffix1) :-
447		split_atom_with_empty(Path1,['/','\\'],PC1),
448		split_atom_with_empty(Path2,['/','\\'],PC2),
449		split_com_aux(PC1,PC2,Com,Suff),
450		ajoin_with_sep(Com,'/',CommonPrefix),
451		ajoin_with_sep(Suff,'/',Suffix1).
452
453		split_com_aux([],_,[],Suffix) :- !, Suffix=[].
454		split_com_aux([H|T1],[H|T2],[H|CT],Suffix) :- !,
455		split_com_aux(T1,T2,CT,Suffix).
456		split_com_aux(P1,_,[],P1).
457
458
459		:- assert_must_succeed(tools:gen_relative_path('/aaaa/bbb/cc/d.app','/aaaa/e.app','bbb/cc/d.app')).
460		:- assert_must_succeed(tools:gen_relative_path('/aaaa/bbb/cc/d.app','/aaaa/bbb/e.app','cc/d.app')).
461		:- assert_must_succeed(tools:gen_relative_path('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/e.app','d.app')).
462		:- assert_must_succeed(tools:gen_relative_path('/aaaa/bbb/cc/d.app','/aaaa/xx/e.app','../bbb/cc/d.app')).
463		:- assert_must_succeed(tools:gen_relative_path('/aaaa/bbb/cc/d.app','/aaaa/xx/yy/e.app','../../bbb/cc/d.app')).
464		:- assert_must_succeed(tools:gen_relative_path('/aaaa/bbb/cc/d.app','/aaaa/xx/yy/','../../bbb/cc/d.app')).
465		:- assert_must_succeed(tools:gen_relative_path('d.app','/aaaa/xx/yy/','d.app')).
466		:- assert_must_succeed(tools:gen_relative_path('d/e.app','/aaaa/xx/yy/','d/e.app')).
467		% can be used for already expanded full paths;
468		% the relative_to option absolute_file_name does not seem to work on already expanded full paths
469		gen_relative_path(Path,ReferencePath,RelPath) :-
470		split_atom_with_empty(Path,['/','\\'],PC1),
471		(PC1 = [File|_], File \= ''
472		-> % this is a relative path, not an absolute one; this is not the intended use of this predicate
473		RelPath = Path % but can happen, e.g., in error_manager
474		; split_atom_with_empty(ReferencePath,['/','\\'],PC2),
475		split_com_aux(PC1,PC2,_,Suff1),
476		split_com_aux(PC2,PC1,_,Suff2),
477		(Suff2=[_|D2] -> true ; D2=Suff2), % remove last entry
478		maplist(replace_by_dotdot,D2,DotDot), % replace directory names by ..
479		append(DotDot,Suff1,Rel1),
480		ajoin_with_sep(Rel1,'/',RelPath)
481		).
482
483		replace_by_dotdot(_,'..').
484
485		:- use_module(library(file_systems),[current_directory/1]).
486		gen_relative_path_to_cur_dir(Path,RelPath) :-
487		current_directory(CurDir),
488		gen_relative_path(Path,CurDir,RelPath).
489
490
491		:- assert_must_succeed(tools:is_absolute_path('/aaaa/bbb/cc/d.app')).
492		:- assert_must_fail(tools:is_absolute_path('cc/d.app')).
493		:- assert_must_fail(tools:is_absolute_path('./cc/')).
494		is_absolute_path(Path) :-
495		atom_chars(Path,PathAscii),
496		PathAscii = ['/'|_]. % TO DO: add other rules for windows C: ...
497
498		:- assert_must_succeed(tools:get_parent_directory('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/')).
499		:- assert_must_succeed(tools:get_parent_directory('/aaaa/bbb/cc/','/aaaa/bbb/cc/')).
500		:- assert_must_succeed(tools:get_parent_directory('d.app','')).
501		:- assert_must_succeed(tools:get_parent_directory('/a/b/cc/(machine from Jupyter cell).mch','/a/b/cc/')).
502		:- assert_must_succeed(tools:get_parent_directory('D:\\Users\\OneDrive - hhu\\[Master] PA\\models\\r\\RF.mch',
503		'D:\\Users\\OneDrive - hhu\\[Master] PA\\models\\r\\')).
504
505		get_parent_directory(Path,NewPath) :-
506		atom_chars(Path,PathAscii),
507		strip_last(PathAscii,[],[],New),
508		atom_chars(NewPath,New).
509
510		:- assert_must_succeed(tools:get_parent_directory_of_directory('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/')).
511		:- assert_must_succeed(tools:get_parent_directory_of_directory('/aaaa/bbb/cc/','/aaaa/bbb/')).
512		:- assert_must_succeed(tools:get_parent_directory_of_directory('\\aaaa\\bb b\\cc\\','\\aaaa\\bb b\\')).
513		% just like get_parent_directory, except when last character is a slash
514		get_parent_directory_of_directory(Path,NewPath) :-
515		atom_chars(Path,PathAscii0),
516		(append(PathAscii,[Last],PathAscii0), is_path_slash(Last)
517		-> true ; PathAscii=PathAscii0),
518		strip_last(PathAscii,[],[],New),
519		atom_chars(NewPath,New).
520
521		is_path_slash('/').
522		is_path_slash('\\'). % Windows
523
524		:- assert_must_succeed(tools:get_parent_directory_name('/aaaa/bbb/cc/d.app','cc')).
525		:- assert_must_succeed(tools:get_parent_directory_name('/aaaa/bbb/cc/','cc')).
526		:- assert_must_succeed(tools:get_parent_directory_name('\\aaaa\\bbb\\cc\\','cc')).
527		:- assert_must_succeed(tools:get_parent_directory_name('\\aaaa\\bbb b\\cc c\\','cc c')).
528		:- assert_must_fail(tools:get_parent_directory_name('d.app',_)).
529		:- assert_must_succeed(tools:get_parent_directory_name('/a/b/cd/(machine from Jupyter cell).mch','cd')).
530
531		get_parent_directory_name(Path,DirName) :-
532		atom_chars(Path,P1),
533		split_last2_lst(P1, ['/','\\'], [],[], P2, _),
534		split_last2_lst(P2, ['/','\\'], [],[], _, DChars),
535		atom_chars(DirName,DChars).
536
537		:- use_module(library(lists)).
538
539		% strip part after last path slash
540		strip_last([],ResSoFar,_,Res) :- reverse(ResSoFar,Res).
541		strip_last([Slash|Tail],ResSoFar,StripSoFar,Res) :- is_path_slash(Slash), !,
542		append([Slash|StripSoFar],ResSoFar,NewRes),
543		strip_last(Tail,NewRes,[],Res).
544		strip_last([A|Tail],ResSoFar,StripSoFar,Res) :-
545		strip_last(Tail,ResSoFar,[A|StripSoFar],Res).
546
547		:- assert_must_succeed((tools:split_atom('ef,g',[','],R), R==[ef,g])).
548		:- assert_must_succeed((tools:split_atom('ef, g',[',',' '],R), R==[ef,g])).
549		:- assert_must_succeed((tools:split_atom('ab,cd,ef,g',[','],R), R==['ab','cd',ef,g])).
550		:- assert_must_succeed((tools:split_atom('ab,cd,ef;g',[',',';'],R), R==['ab','cd',ef,g])).
551		:- assert_must_succeed((tools:split_atom('/ef/g/',['/'],R), R==[ef,g])).
552
553		split_atom(Atom,SepList,SplitList) :-
554		atom_chars(Atom,ListAscii),
555		split2(ListAscii,SepList,SplitList).
556
557		split2([],_,R) :- !,R=[].
558		split2(List,Sep,Res) :- get_next_word(List,Sep,Word,Tail),!,
559		(Word=[]
560		-> split2(Tail,Sep,Res) % skip empty atom
561		; Res=[Atom|TA], atom_chars(Atom,Word),
562		split2(Tail,Sep,TA)).
563
564		get_next_word([],_Sep,[],[]).
565		get_next_word([H|T],Sep,Word,Tail) :-
566	?	member(H,Sep) -> Word=[],Tail=T
567		; Word=[H|TR], get_next_word(T,Sep,TR,Tail).
568
569
570		:- assert_must_succeed((tools:split_atom_with_empty('/ef/g/',['/'],R), R==['',ef,g,''])).
571		:- assert_must_succeed((tools:split_atom_with_empty('/ef/g',['/'],R), R==['',ef,g])).
572		:- assert_must_succeed((tools:split_atom_with_empty('ef/g',['/'],R), R==[ef,g])).
573		:- assert_must_succeed((tools:split_atom_with_empty('efg',['/'],R), R==[efg])).
574
575		% a version of split atom that also returns empty sub atoms
576		split_atom_with_empty(Atom,SepList,SplitList) :-
577		atom_chars(Atom,ListAscii),
578		split_wempty2(ListAscii,SepList,SplitList).
579
580		split_wempty2(List,Sep,Res) :-
581		get_next_match(List,Sep,Word,Tail),!,
582		Res=[Atom|TA], atom_chars(Atom,Word),
583		split_wempty2(Tail,Sep,TA).
584		split_wempty2(List,_,[Atom]) :- atom_chars(Atom,List).
585
586		get_next_match([H|T],Sep,Word,Tail) :-
587	?	member(H,Sep) -> Word=[],Tail=T
588		; Word=[H|TR], get_next_match(T,Sep,TR,Tail).
589
590
591		:- assert_must_succeed((tools:split_complex_sep("ef,,g,h",",,",R), R==["ef","g,h"])).
592		% a version of split that allows longer seperators, % TO DO: make more efficient
593		split_complex_sep(L,Sep,[First|Rest]) :- append(Sep,LRest,SepR),
594		append(First,SepR,L),
595		!,
596		split_complex_sep(LRest,Sep,Rest).
597		split_complex_sep(H,_,[H]).
598
599
600		:- assert_must_succeed((tools:split_chars("ef,g",",",R), R==["ef","g"])).
601		:- assert_must_succeed((tools:split_chars("10",".",R), R==["10"])).
602		:- assert_must_succeed((tools:split_chars("",".",R), R==[""])).
603		:- assert_must_succeed((tools:split_chars("1.0",".",R), R==["1","0"])).
604		:- assert_must_succeed((tools:split_chars("1.",".",R), R==["1",""])).
605		:- assert_must_succeed((tools:split_chars(".1",".",R), R==["","1"])).
606
607		split_chars(List,Sep,Res) :- get_next_word_until_sep(List,Sep,Word,Tail),!,
608		Res=[Word|TA],
609		split_chars(Tail,Sep,TA).
610		split_chars(List,_,[List]).
611
612		get_next_word_until_sep([H|T],Sep,Word,Tail) :-
613		member(H,Sep) -> Word=[],Tail=T
614		; Word=[H|TR], get_next_word_until_sep(T,Sep,TR,Tail).
615
616		:- assert_must_succeed(tools:split_last('/aaaa/bbb/cc/d.app','/','/aaaa/bbb/cc','d.app')).
617		:- assert_must_succeed(tools:split_last('/aaaa/bbb/cc/d.app','.','/aaaa/bbb/cc/d','app')).
618		split_last(Atom, Sep, Head, Tail) :- \+ atom(Sep),!,
619		add_internal_error('Separator not an atom: ', split_last(Atom, Sep, Head, Tail)),fail.
620		split_last(Atom, Sep, Head, Tail) :- atom_chars(Sep,SepACodes),
621		split_last_lst(Atom,SepACodes,Head,Tail).
622
623
624		:- assert_must_succeed(tools:split_last_lst('/aaaa/bbb;cc/d.app',['/',';'],'/aaaa/bbb;cc','d.app')).
625		:- assert_must_succeed(tools:split_last_lst('/aaaa/bbb/cc/d.app',['.'],'/aaaa/bbb/cc/d','app')).
626		% a list version of split_last: obtains a list of sperator chars
627		split_last_lst(Atom, Seps, Head, Tail) :- \+ atom(Atom),!,
628		add_internal_error('First arg not an atom: ', split_last_lst(Atom, Seps, Head, Tail)),fail.
629		split_last_lst(Atom, Seps, Head, Tail) :-
630		atom_chars(Atom,ListAscii),
631		split_last2_lst(ListAscii,Seps,[],[],HeadA, TailA),
632		atom_chars(Head,HeadA), atom_chars(Tail,TailA).
633
634		split_last2_lst([],_,CurSplit,[_|Head],ResH,ResT) :-
635		reverse(CurSplit,ResT),
636		reverse(Head,ResH).
637	?	split_last2_lst([Sep|Tail],Seps,CurSplit,Head,ResH,ResT) :- member(Sep,Seps), % TO DO: use ord_member ?
638		!,
639		append([Sep|CurSplit],Head,NewHead),
640		split_last2_lst(Tail,Seps,[],NewHead,ResH,ResT).
641		split_last2_lst([H|Tail],Seps,CurSplit,Head,ResH,ResT) :-
642		split_last2_lst(Tail,Seps,[H|CurSplit],Head,ResH,ResT).
643
644
645
646		:- assert_must_succeed(tools:split_filename('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/d','app')).
647		:- assert_must_succeed((Z='/aaaa/bbb/cc/d',tools:split_filename(Z,R,X),X=='',R==Z)).
648
649		split_filename(Filename,Base,Ext) :-
650		(split_last(Filename,'.',Base,Ext) -> true ; Base=Filename,Ext='').
651
652
653		:- assert_must_succeed(tools:get_tail_filename('/aaaa/bbb/cc/d.app','d.app')).
654		:- assert_must_succeed(tools:get_tail_filename('\\aaaa\\bbb\\c\\d.app','d.app')).
655		:- assert_must_succeed(tools:get_tail_filename('d.app','d.app')).
656		:- assert_must_succeed(tools:get_tail_filename('/aaaa/bbb/cc/','')).
657		get_tail_filename(Path,Tail) :- compound(Path),!,
658		add_internal_error('Not a filename: ',get_tail_filename(Path,Tail)),
659		Tail=Path.
660		get_tail_filename(Path,Tail) :- (split_last_lst(Path, ['/','\\'], _, T) -> Tail=T ; Tail=Path).
661
662		:- assert_must_succeed(tools:get_modulename_filename('/aaaa/bbb/cc/d.app','d')).
663		:- assert_must_succeed(tools:get_modulename_filename('d.app','d')).
664		get_modulename_filename(Path,Module) :-
665		get_tail_filename(Path,Tail),
666		(split_last(Tail, '.', M, _) -> Module=M ; Module=Tail).
667
668
669		:- assert_must_succeed(get_filename_extension('/aaaa/bbb/cc/d.app','app')).
670		get_filename_extension(Path,Ext) :- split_filename(Path,_,Ext).
671
672		% also works if numbers passed (can happen by accident in test_runner ...)
673		% absolute_file_name('$a',X) generates a permission error
674		safe_absolute_file_name(F,AF,Options) :-
675		ensure_atom(F,A),
676		catch(
677		absolute_file_name(A,AF,Options),
678		error(permission_error(_,_,_),ERR),
679		(format('*** Permission Error for absolute_file_name: ~w~n',[ERR]),AF=F)).
680
681		safe_absolute_file_name(F,AF) :- safe_absolute_file_name(F,AF,[]).
682
683		% host_platform specific check if file names match
684		same_file_name(F,F) :- !.
685		same_file_name(File1,File2) :- host_file_name_case_insensitive,
686		atom_codes(File1,FC1),
687		atom_codes(File2,FC2),
688		maplist(case_insensitive_match,FC1,FC2).
689
690		case_insensitive_match(Code,Code) :- !.
691		case_insensitive_match(C1,C2) :-
692		simple_lowcase(C1,L1),
693		simple_lowcase(C2,L1).
694
695		% TODO: are there other changes to be made in Windows filenames?
696		simple_lowcase(H,R) :- H >="A", H=<"Z", !, R is H+"a"-"A".
697		simple_lowcase(92,R) :- !, R=47. % convert Windows path divider \ to Unix one /
698		simple_lowcase(Code,Code).
699
700		host_file_name_case_insensitive :-
701		host_platform(Platform),
702		host_file_name_case_insensitive(Platform).
703		host_file_name_case_insensitive(windows).
704		host_file_name_case_insensitive(darwin). % by default case insensitive, but up/lower case stored
705		% TODO: can we check if main filesystem is case sensitive??
706
707		%*******************************************************************************
708		% remove_all(A,B,Result): Result is the list of elements of A which do not occur in B
709		remove_all([],_,[]).
710		remove_all([H|T],Remove,Result) :-
711	?	(member(H,Remove) -> !,Result = Rest ; Result = [H|Rest]),
712		remove_all(T,Remove,Rest).
713
714
715
716		%*******************************************************************************
717		% get options from Prolog list passed as parameter
718
719
720		:- assert_must_succeed((get_option_from_list(b,2,[a/false,b/true],B),B==true)).
721		get_option_from_list(Option,Default, OptionList,Value) :-
722		(memberchk(Option/V,OptionList) -> Value=V ; Value=Default).
723
724
725		:- assert_must_succeed(get_options_from_list([option(a,true,false)],[a/false,b/true])).
726		:- assert_must_succeed((get_options_from_list([option(a,true,A)],[a/false,b/true]),A==false)).
727		:- assert_must_succeed((get_options_from_list([option(c,3,C),option(b,1,B),option(a,2,A)],[a/false,b/true]),
728		A==false,B==true,C==3)).
729
730		:- use_module(library(lists), [select/3]).
731
732		get_options_from_list([],_OptionList). % TO DO: provide optional check that no other options left
733		get_options_from_list([option(OptionName,Default,Value)|T],OptionList) :-
734	?	(select(OptionName/V,OptionList,Rest) -> Value=V
735		; Value=Default, Rest=OptionList),
736		get_options_from_list(T,Rest).
737
738
739		%*******************************************************************************
740		% get_options/4 for parsing command line arguments
741
742
743		get_options(List,Pred,Options,Rest) :-
744		get_options(List,Pred,Options,Rest,halt).
745		get_options([],_,[],[],_).
746		get_options([X|T],Recognised,Options,Args,HALTCMD) :-
747	?	( call(Recognised,X,Opt,Values,Action)
748		->
749		( append(Values, Rest, T) -> true
750		;
751		length(Values,Len),
752		length(T,TLen),
753		(TLen < Len
754		-> format('Command ~w expects ~w argument(s); ~w provided.~n',[X,Len,TLen])
755		; format('~nInvalid argument(s) for option: ~w.~n',[X]) % will never happen ??
756		),
757		HALTCMD),
758		( call(Action) -> true
759		;
760		format('~nInvalid argument(s) for option ~w : ~w.~n',[X,Values]),
761		HALTCMD),
762		RT = Rest,
763		Options = [Opt|OT], Args = AT
764		; % option not recognised, keep in Args list (for probcli these are assumed to be files)
765		Options = OT, Args = [X|AT],
766		RT = T
767		),
768		get_options(RT,Recognised,OT,AT,HALTCMD).
769
770		arg_is_number(Arg,Nr) :- number(Arg),!,Nr=Arg.
771		arg_is_number(Arg,Nr) :- atom(Arg),atom_codes(Arg,Str),safe_number_codes(Nr,Str),number(Nr).
772		arg_is_integer(Arg,Nr) :-
773		( append("-",SPos,Arg) -> % negative number
774		arg_is_number(SPos,Pos),
775		Nr is -Pos
776		;
777		arg_is_number(Arg,Nr)).
778
779		% utilities for command-line arguments
780		% allow Number, _, >Number, <Number
781		arg_is_number_or_wildcard('_',R) :- !, R=_.
782		arg_is_number_or_wildcard('*',R) :- !, R=_. % * on command-line is expanded to files unless quoted
783		arg_is_number_or_wildcard(Arg,R) :- arg_is_number(Arg,N),!,R=N.
784		arg_is_number_or_wildcard(Comparator,R) :- atom(Comparator), atom_codes(Comparator,AC),
785		comparator(AC,CompOp,NC), safe_number_codes(Nr,NC), R=comparison_operator(CompOp,Nr).
786		comparator([0'>|T],>,T). % Ascii code 62
787		comparator([0'<|T],<,T).
788		comparator([0'>,0'=|T],'>=',T).
789		comparator([0'=,0'<|T],'=<',T).
790
791
792		% TO DO: add comparator
793
794		:- use_module(error_manager,[add_warning/3]).
795		check_filename_arg(File,Command) :- tools:arg_is_number(File,_),!,
796		ajoin(['File argument to -',Command,' is a number: '],Msg),
797		add_warning(Command,Msg,File).
798		check_filename_arg(File,Command) :- atom(File),
799		sub_atom(File,0,1,_,'-'), % atom_concat('-',_,File),
800		!,
801		ajoin(['File argument to -',Command,' starts with a hypen: '],Msg),
802		add_warning(Command,Msg,File).
803		check_filename_arg(_,_).
804
805
806		:- assert_must_succeed( tools:convert_list_into_pairs([a],a)).
807		:- assert_must_succeed( (tools:convert_list_into_pairs([a,b,c],R), R = ((a,b),c) )).
808
809		convert_list_into_pairs([X|T],Res) :- !,conv2(T,X,Res).
810		convert_list_into_pairs([],Res) :- !, Res=[].
811		convert_list_into_pairs(X,R) :- add_internal_error('Not a list: ',convert_list_into_pairs(X,R)),R=X.
812		conv2([],X,X).
813		conv2([X|T],Acc,Res) :- conv2(T,(Acc,X),Res).
814
815		:- assert_must_succeed(( tools:convert_pairs_into_list([x],a,R), R==[a] )).
816		%:- assert_must_succeed(( b_interpreter:convert_pairs_into_list([x,y,z],((a,b),c),R), R == [a,b,c] )).
817		:- assert_must_succeed(( tools:convert_pairs_into_list([x,y,z],(a,(b,c)),R), R == [a,b,c] )).
818		:- assert_must_succeed(( tools:convert_pairs_into_list([x,y,z],A,B),nonvar(A),nonvar(B),A=((_,_),_),B=[_,_,_] )).
819
820		% the first argument just indicates the length of the list
821		convert_pairs_into_list([_],X,R) :- !,R=[X].
822		convert_pairs_into_list([_|Guide],(A,B),[A|Rest]) :-
823		convert_pairs_into_list(Guide,B,Rest).
824
825
826
827
828		/* ex: substitute(1, [1,2,3,4], 5, X). */
829		:- assert_must_succeed(( tools:substitute(1, [1,2,3,4], 5, X), X==[5,2,3,4])).
830		substitute(X,L,Y,Res) :- sub(L,X,Y,Res).
831		sub([],_,_,[]).
832		sub([H|T],X,Y,[SH|ST]) :-
833		(H=X -> SH=Y ; SH=H),
834		sub(T,X,Y,ST).
835
836
837
838		:- use_module(tools_strings,[ajoin/2, ajoin_with_sep/3, ajoin_with_limit/3]).
839		% tests are stored here to avoid cyclic module dependencies
840		:- assert_must_succeed((tools_strings: ajoin_with_sep([link,a,xa],'.',Text), Text == 'link.a.xa')).
841		:- assert_must_succeed((tools_strings: ajoin_with_sep([link],'.',Text), Text == 'link')).
842		:- assert_must_succeed((tools_strings: ajoin_with_sep(['',a,''],'.',Text), Text == '.a.')).
843
844		:- assert_must_succeed((tools_strings: ajoin_with_limit(['A','B','C','D'],100,Text), Text == 'ABCD')).
845		:- assert_must_succeed((tools_strings: ajoin_with_limit(['A','B','C','D'],2,Text), Text == 'AB...')).
846
847
848		:- use_module(error_manager,[add_error_and_fail/3]).
849		safe_univ(Term,List) :- nonvar(Term),!,Term=..List.
850		safe_univ(Term,List) :- var(List), !,add_error_and_fail(tools,'Arguments to safe_univ (=..) both var:', safe_univ(Term,List)).
851		safe_univ(Term,List) :- %Term is a variable
852		current_prolog_flag(max_arity,MA),
853		(MA = unbounded -> CL = List ; cut_off_list(List,MA,CL)),
854		!, % avoid pending choice points
855		Term =.. CL.
856
857		cut_off_list([],_,[]).
858		cut_off_list([H|T],MA,R) :- (MA<2 -> R=['...'] ; R=[H|TR],MA1 is MA-1, cut_off_list(T,MA1,TR)).
859
860
861		% a version of safe_univ which does not remove args; just puts the extra arguments into the last arg
862
863		safe_univ_no_cutoff(Term,List) :- nonvar(Term),!,Term=..List.
864		safe_univ_no_cutoff(Term,List) :- var(List), !,
865		add_error_and_fail(tools,'Arguments to safe_univ (=..) both var:', safe_univ_no_cutoff(Term,List)).
866		safe_univ_no_cutoff(Term,List) :- %Term is a variable
867		current_prolog_flag(max_arity,MA),
868		(MA = unbounded -> CL = List ; squash_list(List,MA,CL)),
869		!, % avoid pending choice points
870		Term =.. CL.
871		squash_list([],_,[]).
872		squash_list([H|T],MA,R) :- (MA<3,T\=[] -> R=[H,T] ; R=[H|TR],MA1 is MA-1, squash_list(T,MA1,TR)).
873
874		safe_atom_chars(A,B,Loc) :-
875		catch(atom_chars(A,B), error(E1,E2), (
876		add_internal_error('atom_chars error: ',Loc:E1),
877		throw(error(E1,E2))
878		)).
879
880		:- use_module(tools_strings,[atom_codes_with_limit/2, atom_codes_with_limit/3]).
881
882		safe_atom_codes(V,C) :- var(V),var(C),!,
883		add_internal_error('Variables in call: ',safe_atom_codes(V,C)), C='$VARIABLE$'.
884		safe_atom_codes(A,C) :-
885		catch(atom_codes(A,C), error(representation_error(max_atom_length),_), (
886		print(exception(max_atom_length)),nl,
887		atom_codes_with_limit(A,1000,C)
888		)).
889
890		safe_number_codes(V,C) :- var(V),var(C),!,
891		add_internal_error('Variables in call: ',safe_number_codes(V,C)), C='$VARIABLE$'.
892		safe_number_codes(A,C) :-
893		catch(number_codes(A,C), error(syntax_error(_N),_), (
894		%print(9,syntax_error_in_number_codes(_N)),nl,
895		% in this case safe_number_codes fails ; we cannot convert the codes into a number
896		fail
897		)).
898
899		% for an identifier "x" and a number N, create a new identifier "x$N"
900		number_suffix(Id,N,FullId) :-
901		safe_atom_chars(Id,IdChars,number_suffix1),number_chars(N,NChars),
902		append(IdChars,['$'|NChars],FullIdChars),
903		safe_atom_chars(FullId,FullIdChars,number_suffix2).
904
905
906		:- assert_must_succeed(ensure_atom(19,'19')).
907		% ensure that numbers get converted to atoms:
908		ensure_atom(Var,A) :- var(Var),!, A='_'.
909		ensure_atom(N,Res) :- number(N),!,number_codes(N,C), atom_codes(A,C), Res=A.
910		ensure_atom(A,A).
911
912
913		:- assert_must_succeed(atom_or_number_codes(19,"19")).
914		:- assert_must_succeed(atom_or_number_codes(aa,"aa")).
915		atom_or_number_codes(N,Res) :- number(N),!,number_codes(N,Res).
916		atom_or_number_codes(A,Res) :- atom(A),!,atom_codes(A,Res).
917		atom_or_number_codes(Other,Res) :-
918		add_internal_error('Not atom or number: ',atom_or_number_codes(Other,Res)),
919		Res = [].
920
921
922		:- use_module(tools_strings,[truncate_atom/3]).
923		:- assert_must_succeed((tools_strings:truncate_atom(abcd,100,Text), Text == 'abcd')).
924		:- assert_must_succeed((tools_strings:truncate_atom(abcd,2,Text), Text == 'ab...')).
925		:- assert_must_succeed((tools_strings:truncate_atom(abcd,0,Text), Text == '...')).
926
927
928		wrap_and_truncate_atom(Atom,LineLength,Limit,NewAtom) :- \+ atom(Atom),!,
929		add_internal_error('Argument to wrap_and_truncate_atom not atom: ',wrap_and_truncate_atom(Atom,LineLength,Limit,NewAtom)),
930		NewAtom=Atom.
931		wrap_and_truncate_atom(Atom,LineLength,Limit,NewAtom) :-
932		atom_codes(Atom,Codes),
933		wrap_and_truncate_codes(Codes,LineLength,LineLength,Limit,NewCodes,Chng),
934		(Chng=true -> atom_codes(NewAtom,NewCodes) ; NewAtom=Atom).
935
936		wrap_and_truncate_codes([],_,_,_,[],false).
937		wrap_and_truncate_codes([H|T],CharsOnLineCount,MaxLineLength,TotCount,Res,Chng) :-
938		(TotCount<1 -> Res = [46,46,46],Chng=true /* '...' */
939		; (CharsOnLineCount<1 -> Res=[92,110,H|TT], /* add newline \n */
940		TR=T, L1 is MaxLineLength, Chng=true
941		; H=92,T=[H2|T2] -> Res = [H,H2|TT], /* do not split escaped char */
942		TR=T2, L1 is CharsOnLineCount-1, Chng2=Chng
943		; Res = [H|TT], TR=T, L1 is CharsOnLineCount-1, Chng2=Chng),
944		TC1 is TotCount-1, wrap_and_truncate_codes(TR,L1,MaxLineLength,TC1,TT,Chng2)
945		).
946
947
948		% print_size_of_table counts the number of succeeded calls of the
949		% given predicate
950		get_calls_for_table(Module:P/N,Call) :- !,
951		functor(Call,P,N),
952		call(Module:Call).
953		get_calls_for_table(P/N,Call) :-
954		functor(Call,P,N),
955		call(Call).
956
957		:- volatile count/1.
958		:- dynamic count/1.
959		print_size_of_table(Pred) :- retractall(count(_)),
960		assertz(count(0)),
961		get_calls_for_table(Pred,_),inc_size_of_table,fail.
962		print_size_of_table(Pred) :-
963		print('% size of table for '), print(Pred), print(': '), count(X), print(X),nl.
964		inc_size_of_table :- retract(count(X)),X1 is X+1, assertz(count(X1)).
965
966
967		% ----------------- Sorting ---------------
968
969		safe_sort(Orig,A,B) :- var(A),!, add_internal_error('Illegal call: ',safe_sort(Orig,A,B)),A=B.
970		safe_sort(_,A,B) :- sort(A,B).
971
972		:- use_module(library(samsort)).
973		% a sorting function which checks that there were no multiples in the original list
974		safe_set_sort(Orig,S,Res) :- var(S),!, add_internal_error('Illegal call: ',safe_set_sort(Orig,S,Res)),S=Res.
975		%safe_set_sort(Orig,S,Res) :- !,sort(S,Res).
976		safe_set_sort(Orig,S,Res) :- samsort(S,SS),
977		(SS=[H|T] -> (check_for_multiples(T,H,Orig) -> Res=SS ; sort(SS,Res)) ; Res=SS).
978		check_for_multiples([],_,_).
979		check_for_multiples([H|T],Prev,Origin) :-
980		(H=Prev
981		-> add_error(Origin,'Multiple occurrences in set list of: ',H),fail
982		; check_for_multiples(T,H,Origin)).
983
984		% ----------------------
985
986		safe_functor(Src,F,A,Term) :- var(F),var(A),var(Term),!,
987		add_internal_error('Illegal functor call: ',safe_functor(Src,F,A,Term)),
988		fail.
989		safe_functor(_,F,A,T) :- functor(F,A,T).
990
991
992		print_runtime :- statistics(runtime,[Tot,SinceLast]), print(' Total runtime: '), print(Tot),
993		print(' ms, since last: '), print(SinceLast), print(' ms'),nl.
994
995		:- use_module(debug,[debug_mode/1]).
996		start_ms_timer(timer(R,T,W)) :- statistics(runtime,[R,_]),
997		statistics(total_runtime,[T,_]),
998		statistics(walltime,[W,_]).
999		stop_ms_timer(T) :- stop_ms_timer(T,[runtime/RT,total_runtime/RTT,walltime/WT]),
1000		format('% Runtime: ~w ms (with gc: ~w ms, walltime: ~w ms)~n',[RT,RTT,WT]).
1001		stop_ms_timer_with_debug_msg(T,Msg) :-
1002		(debug_mode(on) -> stop_ms_timer_with_msg(T,Msg) ; true).
1003		stop_ms_timer_with_msg(T,Msg) :- stop_ms_timer(T,[runtime/RT,total_runtime/RTT,walltime/WT]),
1004		statistics(walltime,[WE,_]),
1005		convert_ms_time_to_string(WE,WEStr),
1006		format('% Runtime for ~w: ~w ms (with gc: ~w ms, walltime: ~w ms); since start: ~w~n',[Msg,RT,RTT,WT,WEStr]).
1007		stop_ms_walltimer_with_msg(T,Msg) :- stop_ms_timer(T,[runtime/_RT,total_runtime/_RTT,walltime/WT]),
1008		format('% Walltime for ~w: ~w ms~n',[Msg,WT]).
1009		stop_ms_timer(timer(R,T,W),[runtime/RT,total_runtime/RTT,walltime/WT]) :-!,
1010		statistics(runtime,[RE,_]),
1011		% These refer to CPU time used while executing, excluding time spent in memory management tasks or or in system calls.
1012		statistics(total_runtime,[TE,_]),
1013		% These refer to total CPU time used while executing, including memory management tasks such as garbage collection but excluding system calls.
1014		statistics(walltime,[WE,_]),
1015		% These refer to absolute time elapsed.
1016		RT is RE-R, RTT is TE-T, WT is WE-W.
1017		stop_ms_timer(X,Y) :-
1018		add_internal_error('Illegal call: ', stop_ms_timer(X,Y)),
1019		Y = [].
1020		get_elapsed_walltime(timer(_R,_T,W),WTot) :-
1021		statistics(walltime,[W2,_]), WTot is W2-W.
1022
1023		% convert ms time to a user readable time string
1024		convert_ms_time_to_string(TimeMS,Str) :-
1025		convert_ms_time_to_hms(TimeMS,H,M,S,MS),
1026		(H > 0 -> ajoin([H,' h ', M, ' min ', S, ' sec ', MS, ' ms'],Str)
1027		; M > 0 -> ajoin([M, ' min ', S, ' sec ', MS, ' ms'],Str)
1028		; ajoin([S, ' sec ', MS, ' ms'],Str)).
1029
1030		convert_ms_time_to_hms(TimeMS,Hours,MinsMod,SecsMod,MilSecs) :-
1031		MilSecs is TimeMS mod 1000,
1032		Secs is TimeMS // 1000, SecsMod is Secs mod 60,
1033		Mins is Secs // 60, MinsMod is Mins mod 60,
1034		Hours is Mins // 60.
1035
1036		% get delta timer between old timer1 and current time
1037		get_elapsed_timer(timer(R1,T1,W1),timer(R,T,W)) :-
1038		statistics(runtime,[R2,_]),
1039		statistics(total_runtime,[T2,_]),
1040		statistics(walltime,[W2,_]),
1041		R is R2-R1, T is T2-T1, W is W2-W1.
1042		get_elapsed_runtime(timer(R1,_,_),Delta) :-
1043		statistics(runtime,[R2,_]),
1044		Delta is R2-R1.
1045
1046		% combine (add) two timers
1047		combiner_timer(0,T2,R) :- !, R=T2.
1048		combiner_timer(timer(R1,T1,W1),timer(R2,T2,W2),timer(R,T,W)) :-
1049		R is R1+R2, T is T1+T2, W is W1+W2.
1050
1051		% a timer that measures backtracking times
1052		:- dynamic last_bt_timer/2.
1053		bt_start_ms_timer(Msg) :- retractall(last_bt_timer(Msg,_)),
1054		start_ms_timer(T), assertz(last_bt_timer(Msg,T)).
1055		bt_start_ms_timer(Msg) :- retract(last_bt_timer(Msg,Timer)),
1056		stop_ms_timer(Timer,[runtime/RT,total_runtime/_RTT,walltime/WT]),
1057		format('% Runtime to FINALISE ~w: ~w ms (walltime: ~w ms)~n',[Msg,RT,WT]),
1058		fail.
1059
1060
1061		bt_stop_ms_timer(Msg) :-
1062		retract(last_bt_timer(Msg,Last)),
1063		stop_ms_timer(Last,[runtime/RT,total_runtime/_RTT,walltime/WT]),
1064		format('% Runtime for SOLUTION for ~w: ~w ms (walltime: ~w ms)~n',[Msg,RT,WT]).
1065		bt_stop_ms_timer(Msg) :- start_ms_timer(BT_Timer),
1066		assertz(last_bt_timer(Msg,BT_Timer)),
1067		fail.
1068		% ---------------------------
1069
1070
1071		retract_with_statistics(Module,ListOfFacts) :-
1072		nl,print('Retracting Facts'),nl,
1073		get_memory_used(M),
1074		print(' Memory usage: '),print_memory_used(M),nl,
1075		retract_with_statistics(Module,ListOfFacts,M).
1076
1077
1078		retract_with_statistics(_Module,[],_) :- nl.
1079		retract_with_statistics(Module,[Fact|T],Mem) :-
1080		format('~w : ',[Fact]),
1081		%retractall(Module:Fact),
1082		retract_all_count(Module:Fact,0,Nr), format(' ~w facts : ',[Nr]),
1083		get_memory_used(NewMem),
1084		print_memory_used(NewMem),
1085		print_memory_used_difference(Mem,NewMem),
1086		retract_with_statistics(Module,T,NewMem).
1087
1088		retract_all_count(Fact,Acc,Res) :- \+ (\+ (retract(Fact))),!, A1 is Acc+1, retract_all_count(Fact,A1,Res).
1089		retract_all_count(_,R,R).
1090
1091		:- if(current_prolog_flag(dialect, swi)).
1092		% this could possibly be moved to SWI compatibility code
1093		statistics_memory_used(M) :-
1094		statistics(stack,GL), statistics(trail,T), statistics(heapused,H), M is GL+T+H.
1095		% not sure this computes all of memory used; other keys: globalused, localused, codes
1096		:- else.
1097		statistics_memory_used(M) :- statistics(memory_used,M).
1098		:- endif.
1099
1100		get_memory_used([M,PU]) :- garbage_collect,garbage_collect_atoms, get_memory_used_wo_gc([M,PU]).
1101		get_memory_used_wo_gc([M,PU]) :- statistics(program,[PU,_]),statistics_memory_used(M).
1102		print_memory_used_wo_gc :- print_memory_used_wo_gc(user_output).
1103		print_memory_used_wo_gc(Stream) :- get_memory_used_wo_gc(M), print_memory_used(Stream,M).
1104
1105		print_memory_used(M) :- print_memory_used(user_output,M).
1106		print_memory_used(Stream,[M,PU]) :- print_mb(Stream,M),
1107		write(Stream,' ('), print_mb(Stream,PU), write(Stream,' program) ').
1108
1109		print_memory_used_difference([M1,_PU1],[NewM2,_PU2]) :- Diff is (M1)-(NewM2),
1110		(Diff >= 0 -> print(' freed: '), print_bytes(Diff)
1111		; print(' allocated: '), D2 is -(Diff), print_bytes(D2)),nl.
1112		%print(' / '),Diff2 is (PU1)-(PU2), print_mb(Diff2).
1113		print_bytes(X) :- (X<50000 -> print_kb(X) ; print_mb(X)).
1114		print_gb(X) :- XGB is X / 1000000000, % used instead of deprecated 1048576
1115		format(' ~3f GB',[XGB]).
1116		print_mb(X) :- print_mb(user_output,X).
1117		print_mb(Stream,X) :- XMB is X / 1000000, % used instead of deprecated 1048576
1118		format(Stream,' ~3f MB',[XMB]).
1119		print_kb(X) :- XKB is X / 1000, % used instead of deprecated 1024
1120		format(' ~3f KB',[XKB]).
1121
1122		space_call(Call) :- get_memory_used(M1),
1123		call(Call),
1124		get_memory_used(M2),
1125		print_memory_used(M2),
1126		print_memory_used_difference(M1,M2).
1127
1128		% ---------------------------
1129
1130		:- use_module(library(fastrw),[fast_read/2]).
1131
1132		read_term_from_file(Filename,Term) :-
1133		absolute_file_name(Filename,AbsFilename,[]),
1134		open(AbsFilename,read,Stream),
1135		peek_code(Stream,Code),
1136		read_term_from_file2(Code,Stream,AbsFilename,Term).
1137
1138		read_term_from_file2(Code,Stream,File,Term) :-
1139		fastrw_start_code(Code), !,
1140		close(Stream),
1141		open(File,read,NewStream,[type(binary)]),
1142		fast_read(NewStream,Term),
1143		close(NewStream).
1144		read_term_from_file2(_,Stream,_,Term) :-
1145		read_term(Stream,Term,[]),
1146		close(Stream).
1147
1148		fastrw_start_code(0'D). % like for .prob in parsercall
1149
1150		:- use_module(library(codesio), [read_from_codes/2]).
1151		safe_read_term_from_atom(Atom,Term) :-
1152		safe_atom_codes(Atom,Codes),
1153		safe_read_term_from_codes(Codes,Term).
1154		safe_read_term_from_codes(Codes,Term) :-
1155		(append(_,[46],Codes) % add dot: 46 = '.' if required
1156		-> Codes1 = Codes
1157		; append(Codes,[46],Codes1)
1158		),
1159		catch(read_from_codes(Codes1,Term),
1160		error(syntax_error(StxMsg),_),
1161		(atom_codes(AT,Codes),
1162		ajoin(['Prolog syntax error: ',StxMsg,' in'],Msg),
1163		add_error(read_term_from_codes,Msg,AT), fail)
1164		).
1165
1166
1167		read_string_from_file(Filename,String) :-
1168		absolute_file_name(Filename,AbsFilename,[]),
1169		open(AbsFilename,read,S), % utf
1170		read_string(S,String),
1171		close(S).
1172
1173		% Encoding can be any value of text_encoding preference category: auto, 'ISO-8859-1', 'UTF-8', ...
1174		read_string_from_file(Filename,auto,String) :- !, read_string_from_file(Filename,String).
1175		read_string_from_file(Filename,Encoding,String) :-
1176		absolute_file_name(Filename,AbsFilename,[]),
1177		open(AbsFilename,read,S,[encoding(Encoding)]),
1178		read_string(S,String),
1179		close(S).
1180
1181		read_string(S,String) :-
1182		get_code(S,C),!,
1183		(C= -1
1184		-> String = []
1185		; String = [C|Rest], read_string(S,Rest)).
1186
1187		read_atom_from_file(Filename,Encoding,Atom) :-
1188		read_string_from_file(Filename,Encoding,String),
1189		atom_codes(Atom,String).
1190
1191		% version which catches exceptions
1192		safe_read_string_from_file(Filename,Encoding,String) :-
1193		catch(read_string_from_file(Filename,Encoding,String), E, (
1194		ajoin(['Could not read string from file ',Filename,':'],Msg),
1195		add_error(read_string_from_file,Msg,E),
1196		fail
1197		)).
1198
1199		:- use_module(debug,[debug_format/3]).
1200		% open a file using auto and try and read XML header
1201		% <?xml version="1.0" encoding="UTF-8"?>
1202		% useful to first open file and detect encoding and then re-open file using the found encoding
1203		detect_xml_encoding(Filename,Version,Encoding) :-
1204		absolute_file_name(Filename,AbsFilename,[]),
1205		open(AbsFilename,read,Stream),
1206		call_cleanup(
1207		(
1208		match(" <?xml_version = \"",Stream),
1209		read_quoted_xml_string_contents(Stream,Version),
1210		debug_format(19,'XML version ~s detected~n',[Version]),
1211		(match(" encoding = \"",Stream)
1212		-> read_quoted_xml_string_contents(Stream,EncodingCodes),
1213		debug_format(19,'XML encoding ~s detected~n',[EncodingCodes]),
1214		(EncodingCodes = "windows 1252" -> UEnc=Encoding % only encoding using lower case
1215		; maplist(simple_upcase,EncodingCodes,UEnc) % convert utf-8 to UTF-8;
1216		),
1217		atom_codes(Encoding,UEnc)
1218		; debug_format(19,'No XML encoding detected in header, using auto ~w~n',[Filename]),
1219		Encoding = auto
1220		)
1221		),
1222		close(Stream)).
1223
1224
1225		simple_upcase(H,R) :- H >="a", H=<"z", !, R is H+"A"-"a".
1226		simple_upcase(H,H).
1227
1228		% simple read contents of a string until end quote; no escaping detected (yet)
1229		read_quoted_xml_string_contents(Stream,String) :-
1230		get_code(Stream,C),!,
1231		(C= -1
1232		-> String = []
1233		; C = 34 -> String = [] % string finished
1234		; String=[C|Rest],read_quoted_xml_string_contents(Stream,Rest)).
1235
1236		match([],_).
1237		match([H|T],Stream) :- !, get_code(Stream,C),
1238		match2(H,T,C,Stream).
1239
1240		match2(32,T,C,Stream) :- !, % treat a space character as optional whitespace
1241		(is_ws(C) -> match([32|T],Stream)
1242		; T = [H1|T1],
1243		match2(H1,T1,C,Stream)
1244		).
1245		match2(95,T,C,Stream) :- !, % treat underscore as mandatory whitespace
1246		(is_ws(C) -> match([32|T],Stream)
1247		; debug_format(19,'Not a valid xml header ("~s" instead of whitespace)~n',[[C]]),fail
1248		).
1249		match2(H,T,C,Stream) :-
1250		(C=H -> match(T,Stream)
1251		; format('Not a valid xml header ("~s" instead of "~s")~n',[[C],[H]]),fail
1252		).
1253
1254		is_ws(32).
1255		is_ws(9). % tab
1256		is_ws(10).
1257		is_ws(13).
1258
1259		%! open_temp_file(+BaseName, -Path, -Stream, +Options) is det.
1260		%
1261		% Compatible way to create and open a temporary file.
1262		%
1263		% ReqName will be used as the file name if possible,
1264		% but the actual file name may be different
1265		% (e. g. it may have a unique suffix added).
1266		% Path is the temporary file's full path,
1267		% which is automatically opened for writing as Stream.
1268		% Supported Options are type(binary) and encoding(Encoding).
1269		% see also tmpdir preference, default /tmp/ on Unix
1270
1271		:- if(predicate_property(tmp_file_stream(_,_,_), _)). % SWI
1272
1273		:- use_module(library(lists), [select/4]).
1274		open_temp_file(ReqName, Path, Stream, Options) :-
1275		select(type(binary), Options, encoding(octet), OptionsMod),
1276		!,
1277		open_temp_file(ReqName, Path, Stream, OptionsMod).
1278		open_temp_file(ReqName, Path, Stream, Options) :-
1279		% tmp_file_stream only allows controlling the extension, not the name before it.
1280		get_filename_extension(ReqName, Extension),
1281		tmp_file_stream(Path, Stream, [extension(Extension)|Options]).
1282
1283		:- else. % SICStus
1284
1285		open_temp_file(ReqName, Path, Stream, Options) :-
1286		open(temp(ReqName), write, Stream, [if_exists(generate_unique_name)|Options]),
1287		stream_property(Stream, file_name(Path)).
1288
1289		:- endif.
1290
1291		open_temp_file(ReqName, Path, Stream) :- open_temp_file(ReqName, Path, Stream, []).
1292
1293		% ------------------------------
1294
1295		% encoding atoms for Latex:
1296
1297		latex_escape_atom(Atom,EscAtom) :- \+ atom(Atom),!,
1298		add_internal_error('Cannot escape: ',latex_escape_atom(Atom,EscAtom)),
1299		EscAtom=Atom.
1300		latex_escape_atom(Atom,EscAtom) :-
1301		atom_codes(Atom,Codes), latex_escape_codes(Codes,ECodes), atom_codes(EscAtom,ECodes).
1302
1303		latex_escape_codes([],[]).
1304		%latex_escape_codes([92,C|T],[92,C|ET]) :- !, % already escaped
1305		% latex_escape_codes(T,ET).
1306		latex_escape_codes([C|T],[92,C|ET]) :- latex_escape_code(C),!, % 95 = _ underscore, 92 = \ backslash
1307		latex_escape_codes(T,ET).
1308		latex_escape_codes([Code|T],ET) :- translate_code(Code,String),
1309		!,
1310		append(String,ET2,ET),
1311		latex_escape_codes(T,ET2).
1312		latex_escape_codes([H|T],[H|ET]) :- latex_escape_codes(T,ET).
1313
1314		latex_escape_code(35). % #
1315		latex_escape_code(36). % $
1316		latex_escape_code(37). % %
1317		latex_escape_code(38). % &
1318		latex_escape_code(95). % 95 = _ underscore
1319		latex_escape_code(123). % {
1320		latex_escape_code(125). % }
1321
1322		translate_code(92,"\\textbackslash{}"). % \ % \textbackslash seems to work in both math and normal mode
1323		translate_code(94,"\\textasciicircum{}"). % ^
1324		translate_code(126,"\\textasciitilde{}"). % ~
1325		%translate_code(126,"\\~{}"). % 126 = ~ tilde -> \~{} (\sim would be alternative in math mode)
1326
1327		% ------------------------------
1328
1329		% encoding atoms for B Strings:
1330		% escape special characters so that we can output the string between quotes "..." and obtain a valid value
1331
1332		:- assert_must_succeed(tools:b_escape_string_atom('{"a"}','{\\"a\\"}')).
1333		:- assert_must_succeed(tools:b_escape_string_atom('{"a \\/ b"}','{\\"a \\/ b\\"}')).
1334
1335		b_escape_string_atom(Atom,EscAtom) :- \+ atom(Atom),!,
1336		add_internal_error('Cannot escape: ',b_escape_string_atom(Atom,EscAtom)),
1337		EscAtom=Atom.
1338		b_escape_string_atom(Atom,EscAtom) :-
1339		atom_codes(Atom,Codes), b_string_escape_codes(Codes,ECodes), atom_codes(EscAtom,ECodes).
1340
1341		b_string_escape_codes([],R) :- !, R=[].
1342		b_string_escape_codes([C|T],Res) :-
1343		(C=92, T=[C2|_], % 92 = \ backslash
1344		\+ valid_backslash_escape(C2) % we do not need to escape the \ in \x for example, but we need to escape in \n
1345		-> Res = [92|ET]
1346		; b_escape_code(C,EC) -> Res = [92,EC|ET]
1347		; Res = [C|ET]
1348		),
1349		b_string_escape_codes(T,ET).
1350
1351		b_escape_code(9,116). % tab, 116 = t
1352		b_escape_code(10,110). % newline, 110 = n
1353		b_escape_code(13,114). % return 114 = r
1354		b_escape_code(34,34). % "
1355		%b_escape_code(39,39). % ' % not necessary for "..." literals
1356		b_escape_code(92,92). % \
1357
1358		% these are the escape codes the parser / ProB currently supports:
1359		valid_backslash_escape(34). % "
1360		valid_backslash_escape(39). % '
1361		valid_backslash_escape(92). % \
1362		valid_backslash_escape(110). %n
1363		valid_backslash_escape(114). %r
1364		valid_backslash_escape(116). %t
1365
1366		% ------------------------------
1367
1368
1369		%%
1370		% Escape is needed for &, \/, /\, ", ', etc.
1371		% used mainly for dot output
1372		% It seems dotty does not understand escapes, neither C style nor HTML style.
1373		% Dot does render '&' correctly, no matter of escape.
1374		%
1375
1376		print_escaped(Atom) :- string_escape(Atom,E), write(E).
1377
1378		:- use_module(library(lists), [
1379		maplist/3,
1380		scanlist/4]).
1381
1382		string_escape(Atom, EscapedAtom):-
1383		string_escape(dot_string_escape_map, Atom, EscapedAtom).
1384
1385
1386		string_escape(_,Number, EscapedAtom):-
1387		number(Number),!, number_chars(Number,C), atom_chars(EscapedAtom,C). % to detect when label=value
1388		string_escape(Map, Atom, EscapedAtom):-
1389		atom(Atom),
1390		atom_chars(Atom, Chars),
1391		maplist(Map, Chars, EscapedChars),
1392		scanlist(x_atom_concat_rev, EscapedChars, '', EscapedAtom),!.
1393		string_escape(Map,Term, EscapedTerm):-
1394		Term =.. [Fkt|Args],
1395		string_escape(Map, Fkt, EscapedFkt),
1396		maplist(string_escape(Map), Args, EscapedArgs),!,
1397		EscapedTerm =.. [EscapedFkt|EscapedArgs].
1398		string_escape(_,X,X).
1399
1400
1401		x_atom_concat_rev(A,B,BA):-
1402		atom_concat(B,A,BA).
1403
1404
1405		% simple escape, just ensuring no syntax errors and not disturbing records already constructed as B string,...
1406		% however, not that fields of records are already escaped
1407		simple_dot_string_escape(Number, EscapedAtom) :- number(Number),!,
1408		number_chars(Number,C), atom_chars(EscapedAtom,C).
1409		simple_dot_string_escape(Atom, EscapedAtom) :- atom(Atom),!,
1410		atom_chars(Atom,Chars),
1411		simple_dot_esc( Chars, EC), atom_chars(EscapedAtom,EC).
1412		simple_dot_string_escape(Atom,Res) :-
1413		add_internal_error('Not atomic: ',simple_dot_string_escape(Atom,Res)),
1414		Res=Atom.
1415
1416		simple_dot_esc([],[]).
1417		simple_dot_esc(['\\','"' | T],['\\','"' |TR]) :- !, % already escaped
1418		simple_dot_esc(T,TR).
1419		simple_dot_esc(['\\','\\' | T],['\\','\\' |TR]) :- !, % already escaped
1420		simple_dot_esc(T,TR).
1421		simple_dot_esc(['"' | T],['\\','"' |TR]) :- !,
1422		simple_dot_esc(T,TR).
1423		simple_dot_esc([H | T],[H|TR]) :-simple_dot_esc(T,TR).
1424
1425
1426		% ----------------
1427
1428
1429		% escape for XML attribute values for use in double quotes
1430		%https://stackoverflow.com/questions/19766669/which-characters-are-permitted-in-xml-attributes
1431		% AttValue ::= '"' ([^<&"] | Reference)* '"'
1432		% | "'" ([^<&'] | Reference)* "'"
1433
1434		xml_attribute_escape(Codes,EscapedCodes) :- xml_attr_escape(Codes,EscapedCodes,[]).
1435		xml_attr_escape([]) --> "".
1436		xml_attr_escape([0'&|T]) --> !, "&", xml_attr_escape(T).
1437		xml_attr_escape([0'<|T]) --> !, "<", xml_attr_escape(T).
1438		xml_attr_escape([0'>|T]) --> !, ">", xml_attr_escape(T). % strictly speaking not necessary for attribute values
1439		xml_attr_escape([10|T]) --> !, " ", xml_attr_escape(T). % newline
1440		xml_attr_escape([9|T]) --> !, " ", xml_attr_escape(T). % tab
1441		xml_attr_escape([0'"|T]) --> !, """, xml_attr_escape(T).
1442		xml_attr_escape([H|T]) --> [H], xml_attr_escape(T).
1443
1444		% ----------------
1445
1446		html_escape(Number, EscapedAtom) :-
1447		number(Number),!, number_chars(Number,C), atom_chars(EscapedAtom,C). % to detect when label=value
1448		html_escape(Atom, EscapedAtom) :-
1449		atom_codes(Atom,Codes),
1450		html_escape_codes(Codes,ECodes),
1451		atom_codes(EscapedAtom,ECodes).
1452		% atom_chars(Atom, Chars),
1453		% maplist(html_string_escape_map, Chars, EscapedChars),!,
1454		% scanlist(x_atom_concat_rev, EscapedChars, '', EscapedAtom). % very inefficient for large atoms
1455
1456
1457		html_escape_codes([],[]).
1458		html_escape_codes([H|T],Res) :-
1459		\+ no_escape_necessary(H), % avoid calling atom_codes
1460		atom_codes(Atom,[H]),
1461		html_string_escape_map(Atom,NewAtom), % TODO: rewrite html_escape map to work with codes
1462		!,
1463		atom_codes(NewAtom,NewCodes),
1464		append(NewCodes,TR,Res),
1465		html_escape_codes(T,TR).
1466		html_escape_codes([H|T],[H|TR]) :-
1467		html_escape_codes(T,TR).
1468
1469		no_escape_necessary(32).
1470		no_escape_necessary(40). % (
1471		no_escape_necessary(41). % )
1472		no_escape_necessary(44). % ,
1473		no_escape_necessary(45). % -
1474		no_escape_necessary(46). % .
1475		no_escape_necessary(61). % =
1476		no_escape_necessary(95).
1477		no_escape_necessary(X) :- (X>=97,X=<122) ; (X>=65, X=<90) ; (X>=48, X=<57). % alphadigit
1478
1479		dot_string_escape_map('\n', '\\n').
1480		dot_string_escape_map('\\', '\\\\').
1481		dot_string_escape_map('"', '\\"').
1482		dot_string_escape_map('\'', '\\\'').
1483		dot_string_escape_map('{', '\\{'). % important if used inside dot records
1484		dot_string_escape_map('}', '\\}'). % important if used inside dot records
1485		dot_string_escape_map('|', '\\|'). % important if used inside dot records
1486		dot_string_escape_map('>', '\\>'). % important if used inside dot records
1487		dot_string_escape_map('<', '\\<'). % important if used inside dot records
1488		dot_string_escape_map(A,B) :- x_string_escape_map(A,B).
1489
1490		html_string_escape_map('&', '&') :- !. % michael: habe diese 3 Zeilen auskommentiert
1491		html_string_escape_map('<', '<') :- !.
1492		html_string_escape_map('>', '>') :- !.
1493		html_string_escape_map('"', '"') :- !.
1494		html_string_escape_map(A,B) :- x_string_escape_map(A,B),!.
1495
1496
1497		% this is the SICSTus encoding for Unicode either \octal_number\ or \xHexNumber\
1498		% See Section 4.1.7.6 Escape Sequences in SICStus Manual (page 60)
1499		x_string_escape_map('\344\', 'ä'). % a mit Umlaut
1500		x_string_escape_map('\366\', 'ö'). % o mit Umlaut
1501		x_string_escape_map('\374\', 'ü'). % u mit Umlaut
1502		x_string_escape_map('\304\', 'Ä'). % A mit Umlaut
1503		x_string_escape_map('\326\', 'Ö'). % O mit Umlaut
1504		x_string_escape_map('\334\', 'Ü'). % U mit Umlaut
1505
1506		x_string_escape_map('\353\', 'ë'). % e mit Umlaut
1507		x_string_escape_map('\313\', 'Ë'). % E mit Umlaut
1508
1509		x_string_escape_map('\350\', 'è'). % e mit Accent
1510		x_string_escape_map('\351\', 'é').
1511		x_string_escape_map('\352\', 'ê').
1512		x_string_escape_map('\310\', 'È'). % E mit Accent
1513		x_string_escape_map('\311\', 'É').
1514		x_string_escape_map('\312\', 'Ê').
1515
1516		x_string_escape_map('\340\', 'à'). % a mit Accent
1517		x_string_escape_map('\341\', 'á').
1518		x_string_escape_map('\342\', 'â').
1519		x_string_escape_map('\300\', 'À'). % A mit Accent
1520		x_string_escape_map('\301\', 'Á').
1521		x_string_escape_map('\302\', 'Â').
1522
1523		x_string_escape_map('\354\', 'ì'). % i mit Accent
1524		x_string_escape_map('\355\', 'í').
1525		x_string_escape_map('\356\', 'î').
1526		x_string_escape_map('\314\', 'Ì'). % I mit Accent
1527		x_string_escape_map('\315\', 'Í').
1528		x_string_escape_map('\316\', 'Î').
1529
1530		x_string_escape_map('\362\', 'ò'). % o mit Accent
1531		x_string_escape_map('\363\', 'ó').
1532		x_string_escape_map('\364\', 'ô').
1533		x_string_escape_map('\322\', 'Ò'). % O mit Accent
1534		x_string_escape_map('\323\', 'Ó').
1535		x_string_escape_map('\324\', 'Ô').
1536
1537		x_string_escape_map('\347\', 'ç'). % cedille
1538		x_string_escape_map('\307\', 'Ç'). % Cedille
1539
1540		x_string_escape_map('\337\', 'ß'). % scharfes S (sz)
1541		x_string_escape_map('\361\', 'ñ'). % n with tilde
1542
1543		x_string_escape_map('\1661\', 'α'). % Greek
1544		x_string_escape_map('\1662\', 'β').
1545		x_string_escape_map('\1663\', 'γ').
1546		x_string_escape_map('\1664\', 'δ').
1547		x_string_escape_map('\1665\', 'ε').
1548		x_string_escape_map('\1666\', 'ζ').
1549		x_string_escape_map('\1667\', 'η').
1550		x_string_escape_map('\1670\', 'θ').
1551		x_string_escape_map('\1671\', 'ι').
1552		x_string_escape_map('\1672\', 'κ').
1553		x_string_escape_map('\1673\', 'λ').
1554		x_string_escape_map('\1674\', 'μ').
1555		x_string_escape_map('\1675\', 'ν').
1556		x_string_escape_map('\1676\', 'ξ').
1557		x_string_escape_map('\1677\', 'ο').
1558		x_string_escape_map('\1700\', 'π').
1559		x_string_escape_map('\1701\', 'ρ').
1560		x_string_escape_map('\1702\', 'ς').
1561		x_string_escape_map('\1703\', 'σ').
1562		x_string_escape_map('\1704\', 'τ').
1563		x_string_escape_map('\1705\', 'υ').
1564		x_string_escape_map('\1706\', 'φ').
1565		x_string_escape_map('\1707\', 'χ').
1566		x_string_escape_map('\1710\', 'ψ').
1567		x_string_escape_map('\1711\', 'ω').
1568
1569		% to do: add missing upper-case Greek letters:
1570		x_string_escape_map('\1624\', 'Δ').
1571		x_string_escape_map('\1630\', 'Θ').
1572		x_string_escape_map('\1633\', 'Λ').
1573		x_string_escape_map('\1636\', 'Ξ').
1574		x_string_escape_map('\1645\', 'Υ').
1575		x_string_escape_map('\1647\', 'Χ').
1576		x_string_escape_map('\1650\', 'Ψ').
1577		x_string_escape_map('\1651\', 'Ω').
1578
1579		% other symbols (converted using http://www.online-toolz.com/tools/unicode-html-entities-convertor.php )
1580		x_string_escape_map('\21242\','⊢'). %vdash turnstyle decimal: 8866
1581		x_string_escape_map('\21250\','⊨'). %models turnstyle decimal: 8872
1582		x_string_escape_map('\x21D4\','⇔'). % equivalence
1583		x_string_escape_map('\x21D2\','⇒'). % implication
1584		x_string_escape_map('\x2203\','∃'). % exists
1585		x_string_escape_map('\x2200\','∀'). % forall
1586		x_string_escape_map('·','·'). % dot used for quantifiers, ASCII 183
1587		x_string_escape_map('\x2227\','∧'). % conjunct
1588		x_string_escape_map('\x2228\','∨'). % disjunct
1589		x_string_escape_map('\xAC\','¬'). % negation
1590		x_string_escape_map('\x21A6\','↦'). % maplet |->
1591		x_string_escape_map('\x2286\','⊆'). % <: subseteq
1592		x_string_escape_map('\x222A\','∪'). % union
1593		x_string_escape_map('\x2229\','∩'). % intersection
1594		x_string_escape_map('\x2205\','∅'). % empty set
1595		x_string_escape_map('\x2260\','≠'). % not equal
1596		x_string_escape_map('\x2264\','≤'). % less equal
1597		x_string_escape_map('\x2265\','≥'). % greater equal
1598		x_string_escape_map('\x2124\','ℤ'). % Z (INTEGER)
1599		x_string_escape_map('\x2115\','ℕ'). % NATURAL
1600
1601		% Numbers without HTML translation: .. 8229
1602
1603		% translate unknown unicode chars to lozenge
1604		x_string_escape_map(Unicode, Result) :- atom(Unicode),
1605		atom_codes(Unicode,[Nr]), Nr>127,
1606		!,
1607		ajoin(['&#',Nr,';'],Result).
1608		%x_string_escape_map(Unicode, '◊') :-
1609		% atom(Unicode), atom_codes(Unicode,[Code]), Code>127.
1610		% format(user_output,'Uni: ~w ~n',[Unicode]).
1611		x_string_escape_map(X, X).
1612
1613		%
1614		% split_list(Pred,List,ListA,ListB):
1615		% List contains exactly the same elements as ListA and ListB
1616		% An element E is member of ListA iff Pred(E) is true and E is element of List.
1617		% An element E is member of ListB iff Pred(E) is false and E is element of List.
1618		% combination of include/exclude from library(lists) (include_exclude)
1619		:- assert_must_succeed(( split_list(number,[1,a,2,b],S,F), S==[1,2], F==[a,b] )).
1620		split_list(Pred,List,A,B) :-
1621		split_list2(List,Pred,A,B).
1622		split_list2([],_Pred,[],[]).
1623		split_list2([Elem|Rest],Pred,A,B) :-
1624	?	( call(Pred,Elem) -> A=[Elem|AR], B=BR
1625		; A=AR, B=[Elem|BR]),
1626		split_list2(Rest,Pred,AR,BR).
1627
1628
1629		:- assert_must_succeed(( map_split_list(just_for_unit_test_add(0),[1,2,3],S,F), S==[10,20,30], F==[] )).
1630		% like map_list but put unsuccessful elements in a second list
1631		map_split_list(Pred,List,A,B) :-
1632		map_split_list2(List,Pred,A,B).
1633		map_split_list2([],_Pred,[],[]).
1634		map_split_list2([Elem|Rest],Pred,A,B) :-
1635		( call(Pred,Elem,Res) -> A=[Res|AR], B=BR
1636		; A=AR, B=[Elem|BR]),
1637		map_split_list2(Rest,Pred,AR,BR).
1638
1639		% a variation of split_list which also returns a list of predicate results
1640		% with re_split_list_idx(L,PredResult,A,B) : we can split another list using the same pattern
1641		split_list_idx(Pred,List,PredResult,A,B) :-
1642		split_list_idx2(List,Pred,PredResult,A,B).
1643		split_list_idx2([],_Pred,[],[],[]).
1644		split_list_idx2([Elem|Rest],Pred,[PredTrue|PT],A,B) :-
1645		(call(Pred,Elem) -> PredTrue=true, A=[Elem|AR], B=BR
1646		; PredTrue=false, A=AR, B=[Elem|BR]),
1647		split_list_idx2(Rest,Pred,PT,AR,BR).
1648
1649
1650		re_split_list_idx([],[],[],[]).
1651		re_split_list_idx([Elem|Rest],[PredTrue|PT],A,B) :-
1652		(PredTrue=true -> A=[Elem|AR], B=BR
1653		; A=AR, B=[Elem|BR]),
1654		re_split_list_idx(Rest,PT,AR,BR).
1655
1656
1657
1658		% try and avoid going through same transitions twice
1659		% works with simple transition ids, or with atom/3 entries from ltl model_checker
1660		:- assert_must_succeed((minimize_lasso([0,1,2,4,8,14,7,12],[15,4,8,14,7,12],P,L),
1661		P==[0,1,2], L==[4,8,14,7,12,15])).
1662		minimize_lasso(Prefix,Loop,NewPrefix,NewLoop) :- reverse(Prefix,RP), reverse(Loop,RL),
1663		common_prefix(RP,RL,Common,RestP,RestLoop),
1664		append(RestLoop,Common,NewLR), reverse(NewLR,NewLoop),
1665		reverse(RestP,NewPrefix).
1666		common_prefix([H|T1],[H|T2],[H|Res],Rest1,Rest2) :- !, common_prefix(T1,T2,Res,Rest1,Rest2).
1667		common_prefix(T1,T2,[],T1,T2).
1668
1669
1670
1671		just_for_unit_test_add(A,B,C) :- C is A+(10*B).
1672		:- assert_must_succeed(( foldl(just_for_unit_test_add,[],0,R), R==0 )).
1673		:- assert_must_succeed(( foldl(just_for_unit_test_add,[3,6,7,2,6],0,R), R==36726 )).
1674
1675		foldl(MPred,List,Start,Result) :-
1676	?	foldl2(List,MPred,Start,Result).
1677		foldl2([],_Pred,Value,Value).
1678		foldl2([Elem|Rest],MPred,OldValue,NewValue) :-
1679	?	call(MPred,Elem,OldValue,Value),
1680	?	foldl2(Rest,MPred,Value,NewValue).
1681
1682
1683		just_for_unit_test_add2(A,B,C,D) :- D is 100*C+10*A+B.
1684		:- assert_must_succeed(( foldl(just_for_unit_test_add2,[],[],0,R), R==0 )).
1685		:- assert_must_succeed(( foldl(just_for_unit_test_add2,[3,6,7,2,6],[5,2,9,0,8],0,R), R==3562792068 )).
1686
1687		foldl(MPred,List,List1,Start,Result) :-
1688		foldl2(List,MPred,List1,Start,Result).
1689		foldl2([],_Pred,[],Value,Value).
1690		foldl2([Elem|Rest],MPred,[H1|R1],OldValue,NewValue) :-
1691		call(MPred,Elem,H1,OldValue,Value),
1692		foldl2(Rest,MPred,R1,Value,NewValue).
1693
1694
1695		just_for_unit_test_add3(A,B,C,D,E) :- E is D*1000+100*A+10*B+C.
1696		:- assert_must_succeed(( foldl(just_for_unit_test_add3,[],[],[],0,R), R==0 )).
1697		:- assert_must_succeed(( foldl(just_for_unit_test_add3,[3,6,7],[5,2,9],[4,1,0],0,R),
1698		R==354621790 )).
1699
1700		foldl(MPred,A,B,C,Start,Result) :-
1701		foldl2(A,MPred,B,C,Start,Result).
1702		foldl2([],_Pred,[],[],Value,Value).
1703		foldl2([Elem|Rest],MPred,[H1|R1],[H2|R2],OldValue,NewValue) :-
1704		call(MPred,Elem,H1,H2,OldValue,Value),
1705		foldl2(Rest,MPred,R1,R2,Value,NewValue).
1706
1707
1708		:- assert_must_succeed(( maplist5(just_for_unit_test_add2,[],[],[],R), R==[] )).
1709		:- assert_must_succeed(( maplist5(just_for_unit_test_add2,[1],[2],[3],R), R==[312] )).
1710		:- assert_must_succeed(( maplist5(just_for_unit_test_add2,[1,1],[2,0],[3,0],R), R==[312,10] )).
1711
1712		maplist5(_P,[],[],[],[]).
1713		maplist5(P,[H1|T1],[H2|T2],[H3|T3],[H4|T4]) :-
1714		if(call(P,H1,H2,H3,H4),
1715	?	maplist5(P,T1,T2,T3,T4),
1716		(add_internal_error('Call fails: ',maplist5(P,H1,H2,H3,H4)),
1717		fail)).
1718
1719
1720		:- assert_must_succeed(( average([2,4,8,10],Avg), D is abs(Avg-6),D<0.001 )).
1721		:- assert_must_succeed(( average([2],Avg), D is abs(Avg-2), D<0.001 )).
1722		average(List,Avg) :-
1723		length(List,N),sumlist(List,Sum),Avg is Sum/N.
1724
1725
1726		% assert_once works like assertz, but checks if the fact has already been stored before and
1727		% will not store it a second time
1728		assert_once(MPredicate) :-
1729		(call(MPredicate) -> true ; assertz(MPredicate)).
1730
1731
1732
1733		:- dynamic id_counter/1.
1734		unique_id(Prefix,Id) :-
1735		(id_counter(V) -> retractall(id_counter(_)) ; V is 0),
1736		N is V+1,
1737		assertz( id_counter(N) ),
1738		number_codes(N,NCodes),
1739		append(Prefix,NCodes,ICodes),
1740		atom_codes(Id,ICodes).
1741
1742		% PROBPATH is the runtime search path for defintion files not found relative to the original machine.
1743		% By default this is the stdlib directory relative to the prob base dir.
1744		% The user can provide a list of : separated directories in the PROBPATH
1745		% environment variables which are prepended to the default path.
1746		get_PROBPATH(PROBPATH) :-
1747		environ('PROBPATH', CustomPATH),
1748		atom_length(CustomPATH, L),
1749		L > 0, !,
1750		get_path_separator(PS),
1751		get_stdlib_path(STDLIB), ajoin([CustomPATH, PS, STDLIB], PROBPATH).
1752
1753		get_PROBPATH(PROBPATH) :- get_stdlib_path(PROBPATH).
1754
1755		get_stdlib_path(STDLIB) :- runtime_application_path(Base), atom_concat(Base, '/stdlib', STDLIB).
1756
1757		% Platform specific path separator char
1758		map_path_separator(windows, ';').
1759		map_path_separator(_, ':').
1760
1761		get_path_separator(PS) :- host_platform(Platform), map_path_separator(Platform, PS), !.
1762
1763		%% atom_to_number(?Atom, ?Number).
1764		atom_to_number(Atom, Number) :-
1765		atom(Atom),
1766		catch((
1767		atom_codes(Atom, Codes),
1768		number_codes(Number, Codes)
1769		), _, fail).
1770		atom_to_number(Atom, Number) :-
1771		number(Number),
1772		number_codes(Number, Codes),
1773		atom_codes(Atom, Codes).
1774
1775		% ----------
1776
1777		% useful for e.g. SWI Prolog where redefine_warnings is not defined
1778		get_set_optional_prolog_flag(Flag,Old,New) :-
1779		(catch(current_prolog_flag(Flag, Old), error(domain_error(_, _), _), fail) ->
1780		set_prolog_flag(Flag, New)
1781		;
1782		current_prolog_flag(dialect, Prolog),
1783		format('Prolog flag ~w not supported on ~w~n', [Flag, Prolog])
1784		).
1785
1786
1787		% ----------
1788
1789		% predicates for lists with optional items represented using optional_value(V,pred_true/pred_false)
1790		% we assume that optional values constructors (optional_value/2) are instantiated *before* calling maplist_optional
1791
1792	?	map_optlist(Pred,List) :- map_optlist_aux(List,Pred).
1793
1794		:- block map_optlist_aux(-,?).
1795		map_optlist_aux([],_) :- !.
1796		map_optlist_aux([H|T],Pred) :- !,
1797	?	call_optional(Pred,H),
1798	?	map_optlist_aux(T,Pred).
1799		map_optlist_aux(Other,Pred) :-
1800		add_internal_error('First argument not a list:',map_optlist_aux(Other,Pred)).
1801
1802		call_optional(Pred,OptVal) :-
1803		is_optional_value(OptVal,Val,Use),
1804		!,
1805		call_optional_aux(Use,Pred,Val).
1806	?	call_optional(Pred,Val) :- call(Pred,Val).
1807
1808		:- block call_optional_aux(-,?,?).
1809		call_optional_aux(pred_true,Pred,Val) :- !, call(Pred,Val).
1810		call_optional_aux(pred_false,_,_) :- !. % ignore optional item
1811		call_optional_aux(Other,Pred,_) :-
1812		add_internal_error('First argument not a BOOL:',call_optional_aux(Other,Pred)).
1813
1814		:- block optlist_to_list(-,?).
1815		optlist_to_list([],R) :- !, R=[].
1816		optlist_to_list([OptVal|T],R) :- !,
1817		(is_optional_value(OptVal,Val,Use)
1818		-> optlist_to_list_aux(Use,Val,T,R)
1819		; R = [OptVal|RT], optlist_to_list(T,RT)
1820		).
1821		optlist_to_list(Other,R) :-
1822		add_internal_error('First argument not a list:',optlist_to_list(Other,R)),
1823		R=Other.
1824
1825		:- block optlist_to_list_aux(-,?,?,?).
1826		optlist_to_list_aux(pred_true,Val,T,[Val|TR]) :- !, optlist_to_list(T,TR).
1827		optlist_to_list_aux(pred_false,_,T,R) :- !, optlist_to_list(T,R).
1828		optlist_to_list_aux(Other,V,T,R) :-
1829		add_internal_error('First argument not a BOOL:',optlist_to_list_aux(Other,V,T,R)),
1830		fail.
1831
1832		is_optional_value(OptVal,Val,Use) :- nonvar(OptVal), OptVal = optional_value(Val,Use).
1833
1834		% ---------
1835
1836		% blackboard utilities
1837
1838
1839		bb_safe_get(Counter,R) :- (bb_get(Counter,X) -> R=X ; R=0).
1840
1841		bb_inc(Counter) :- bb_inc_by(Counter,1).
1842
1843		bb_inc_by(Counter,Inc) :-
1844		bb_safe_get(Counter,R),
1845		R1 is R+Inc, bb_put(Counter,R1).