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
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		print_wtime/1,
19		print_mb/1,
20		prints/1,
21		host_platform/1, platform_is_64_bit/0, max_tagged_integer/1, max_tagged_pow2/1,
22		is_tagged_integer/1,
23		is_absolute_path/1,
24		get_parent_directory/2, get_tail_filename/2, get_modulename_filename/2,
25		get_filename_extension/2,
26		get_options/4,get_options/5,
27		arg_is_number/2, arg_is_number_or_wildcard/2,
28		check_filename_arg/2,
29		arg_is_integer/2,
30		split_filename/3,
31		safe_absolute_file_name/2, safe_absolute_file_name/3,
32
33		filter/4,
34		flatten/2,
35		% count_occurences/2, % now in tools_lists
36		split_last/4,
37		split_atom/3, split_chars/3, split_complex_sep/3,
38		latex_escape_atom/2,
39		b_escape_string_atom/2, b_string_escape_codes/2,
40		string_escape/2, print_escaped/1, % can also be used for dot
41		html_escape/2,
42		read_string_from_file/2, read_string_from_file/3,
43		% write_lines_to_file/2, % now in tools_files
44
45		is_list_simple/1,
46		ajoin/2,
47		ajoin_with_limit/3,
48		ajoin_with_sep/3,
49		substitute/4,
50		% call_residue/2, % now in tools_meta
51
52		catch_call/1,
53		%safe_on_exception/3, safe_on_exception_silent/3, % now in tools_meta
54		%reraise_important_exception/1, % now in tools_meta
55		% catch_matching/3, % now in tools_meta
56
57		convert_list_into_pairs/2, convert_pairs_into_list/3,
58
59		safe_univ/2, safe_univ_no_cutoff/2,
60		safe_sort/3,
61		safe_functor/4,
62
63		safe_atom_codes/2, safe_atom_chars/3,
64		atom_codes_with_limit/2, atom_codes_with_limit/3,
65		truncate_atom/3, wrap_and_truncate_atom/4,
66		safe_number_codes/2,
67		ensure_atom/2,
68		number_suffix/3,
69
70		print_size_of_table/1,
71		print_runtime/0, start_ms_timer/1, stop_ms_timer/2, stop_ms_timer/1,
72		stop_ms_timer_with_msg/2, stop_ms_walltimer_with_msg/2,
73		bt_start_ms_timer/1, bt_stop_ms_timer/1,
74		get_elapsed_walltime/2,
75		cputime/1, walltime/1,
76
77		retract_with_statistics/2,
78		get_memory_used/1, print_memory_used_difference/2, print_memory_used/1,
79		print_memory_used_wo_gc/0,
80
81		split_list/4,
82		split_list_idx/5, re_split_list_idx/4,
83		foldl/4,foldl/5,foldl/6,
84		average/2,
85
86		(space_call)/1,
87		assert_once/1,
88
89		% safe_time_out/3, % now in tools_meta
90		% time_out_call/2, time_out_call/1, time_out_with_factor_call/3, % now in tools_timeout
91
92		unique_id/2,
93
94		get_PROBPATH/1
95		]).
96
97		:- use_module(module_information).
98
99		:- module_info(group,infrastructure).
100		:- module_info(description,'This module contains many general helper predicates.').
101
102		:- use_module(pathes,[runtime_application_path/1]). % we just import it to set-up pathes, we don't need any predicates
103
104		:- use_module(library(lists)).
105		:- use_module(library(system)).
106		%%:- use_module(library(file_systems)). %% not required ?
107		%% :- use_module(library(codesio)).
108
109
110		:- use_module(tools_meta,[reraise_important_exception/1, safe_on_exception/3]).
111
112
113		:- meta_predicate catch_call(0).
114		catch_call(Call) :-
115		on_exception(Exception,call(Call),
116		(add_error(catch_call,'Call raised an exception: ',(Call:Exception)),
117		/* read(_), */
118		reraise_important_exception(Exception),
119		fail)).
120
121
122
123		:- use_module(self_check). % put after search paths have been set
124
125		% --------------------------------------
126
127		cputime(T) :-
128		statistics(runtime,[T,_]).
129
130		walltime(WT) :-
131		statistics(walltime,[WT,_]).
132		% --------------------------------------
133
134		platform_is_64_bit :-
135		prolog_flag(max_tagged_integer,X),
136		X >= 1152921504606846975.
137
138		% equals 268435455 on 32-bit systems, i.e., 2**28 - 1
139		% equals 1152921504606846975 on 64-bit systems
140		max_tagged_integer(X) :- prolog_flag(max_tagged_integer,X).
141
142		max_tagged_pow2(Exp) :-
143		prolog_flag(max_tagged_integer,X),
144		(X >= 1152921504606846975 -> Exp = 60 % we can represent 2**60
145		; Exp = 27). % assume 32 bit
146
147		is_tagged_integer(X) :- prolog_flag(max_tagged_integer,Lim), X =< Lim,
148		prolog_flag(min_tagged_integer,Low), X >= Low.
149
150		host_platform(Res) :-
151		prolog_flag(host_type,HostType),
152		atom_codes(HostType,AsciiList),
153	?	map_host_platform(AsciiList,Res),!.
154
155		map_host_platform(HT,darwin) :- append("powerpc-darwin",_,HT).
156		map_host_platform(HT,darwin) :- append("i386-darwin",_,HT).
157		map_host_platform(HT,darwin) :- append("x86_64-darwin",_,HT).
158		map_host_platform(HT,windows) :- append("x86-win",_,HT).
159		map_host_platform(HT,windows) :- append("x86_64-win",_,HT).
160		map_host_platform(HT,linux) :- append("x86-linux",_,HT).
161		map_host_platform(HT,linux) :- append("x86_64-linux",_,HT).
162		map_host_platform(_,unknown).
163
164		% on Windows XP: 'x86-win32-nt-4'
165		% on MacPro: 'x86_64-darwin-10.6.0'
166		% on Linux: 'x86-linux-glibc2.7'
167
168
169		:- use_module(error_manager,[add_error/3, add_internal_error/2]).
170		print_message(Msg) :- print_message_with_max_depth(Msg,20).
171		print_message_with_max_depth(Msg,MaxDepth) :-
172		safe_on_exception(E,print_message2(Msg,MaxDepth),
173		add_error(tools,'Exception in print_message: ',E)). % added because sometimes in Windows/Vista we get an exception here
174		print_message2(Msg,MaxDepth) :-
175		current_output(X),
176		set_output(user),
177		(var(Msg) -> print_message(informational,'_')
178		; write('% '),write_term(Msg,[max_depth(MaxDepth)]),nl ),
179		set_output(X).
180		print_short_msg(Msg) :-
181		current_output(X),
182		set_output(user),
183		write(Msg),
184		set_output(X).
185
186		print_bt_message(Msg) :- print_message(Msg).
187		print_bt_message(Msg) :- print_message(backtrack(Msg)),
188		%(Msg = found_enumeration_of_constants(_,_) -> trace ; true),
189		fail.
190
191		% like print_bt_message but trace upon backtrack
192		print_bt_trace_message(Msg) :- print_message(Msg).
193		print_bt_trace_message(Msg) :- trace,
194		print_message(backtrack(Msg)),
195		fail.
196
197		% trace upon backtrack:
198		bt_trace(_) :- true.
199		bt_trace(PP) :- print(' * BACKTRACK: '), print(PP),nl, trace,fail.
200
201		print_wtime(PP) :- statistics(walltime,[WT,_]),
202		current_output(X),
203		set_output(user),
204		print(PP), print(' : '), print(WT), print(' ms'),nl,
205		set_output(X).
206
207		% a print that will automatically stop after 25 prints and give the user the option to inspect the printed messages
208		:- dynamic prints_count/1.
209		prints_count(25).
210		prints(L) :- print_bt_message(L),
211		(retract(prints_count(X)) -> true ; X=25),
212		(X<1
213		-> print('*** Stopped printing >'),
214		read(RT),
215		(number(RT) -> X1=RT ; X1=25)
216		; X1 is X-1
217		), assert(prints_count(X1)).
218
219		:- assert_pre(tools:exact_member(_Var,Vs),
220		(list_skeleton(Vs))).
221		:- assert_post(tools:exact_member(_Var,_Vs), true).
222		:- assert_must_succeed(tools:exact_member(V,[V])).
223		:- assert_must_succeed(tools:exact_member(V,[_X,_Z,V])).
224		:- assert_must_fail(tools:exact_member(_W,[_X,_Z,_V])).
225		:- assert_must_fail(tools:exact_member(_W,[])).
226
227		exact_member(X,[Y|T]) :-
228		(X==Y -> true ; exact_member(X,T)).
229
230
231		:- assert_pre(tools:exact_member_lookup(_Var,_ValRes,Vs,Vals),
232		(list_skeleton(Vs),list_skeleton(Vals))).
233		:- assert_post(tools:exact_member_lookup(_Var,_ValRes,_Vs,_Vals), true).
234		:- assert_must_succeed(tools:exact_member_lookup(V,2,[V],[2])).
235		:- assert_must_succeed(tools:exact_member_lookup(V,2,[_X,_Z,V],[1,3,2])).
236		:- assert_must_fail(tools:exact_member_lookup(V,3,[_X,_Z,V],[1,3,2])).
237		:- assert_must_fail(tools:exact_member_lookup(_W,3,[_X,_Z,_V],[1,3,2])).
238		:- assert_must_fail(tools:exact_member_lookup(_W,3,[],[1,3,2])).
239
240		exact_member_lookup(Var,ValRes,[V|TV],[Val|TVal]) :-
241		(Var==V -> ValRes=Val ; exact_member_lookup(Var,ValRes,TV,TVal)).
242
243
244		:- assert_pre(tools:exact_member_replace(_Var,_ValRes,Vs,Vals,_),
245		(list_skeleton(Vs),list_skeleton(Vals))).
246		:- assert_post(tools:exact_member_replace(_Var,_ValRes,_Vs,_Vals,NewVals),
247		list_skeleton(NewVals)).
248		:- assert_must_succeed(tools:exact_member_replace(V,44,[_X,_Z,V],[1,3,2],[1,3,44])).
249		:- assert_must_fail(tools:exact_member_replace(_V,44,[_X,_Z,_VV],[1,3,2],[1,3,44])).
250
251		exact_member_replace(Var,NewVal,[V|TV],[Val|TVal],[NV|TN]) :-
252		((Var==V) -> (NV=NewVal,TN=TVal)
253		; (NV=Val,exact_member_replace(Var,NewVal,TV,TVal,TN))).
254
255
256
257		remove([X|T],X,T).
258	?	remove([Y|T],X,[Y|DT]) :- \+(X=Y), remove(T,X,DT).
259
260		:- assert_must_succeed(tools:flatten([],[])).
261		:- assert_must_succeed(tools:flatten([[1,2,3]],[1,2,3])).
262		:- assert_must_succeed(tools:flatten([[1],[[99]],[2,3],[4,5]],[1,99,2,3,4,5])).
263		:- assert_must_succeed(tools:flatten([[]],[])).
264
265		flatten(List,FlatList) :- flatten1(List,[],FlatList).
266		flatten1([],L,L) :- !.
267		flatten1([H|T],Tail,List) :- !, flatten1(H,FlatList,List), flatten1(T,Tail,FlatList).
268		flatten1(NonList,Tail,[NonList|Tail]).
269
270
271		:- use_module(tools_lists,[count_occurences/2]).
272		:- assert_must_succeed((tools_lists:count_occurences([a,b,a,a,b],R),R == [a-3,b-2])).
273
274
275
276		:- meta_predicate filter(1,*,*,*).
277		:- assert_must_succeed((tools:filter(var,[1,2,X,3,Y],R,Out),R == [X,Y],Out == [1,2,3])).
278		:- assert_must_succeed((tools:filter(nonvar,[1,2,X,3,Y],R,Out),R == [1,2,3],Out == [X,Y])).
279
280		filter(_Pred,[],[],[]).
281		filter(Pred,[H|T],True,False) :-
282		(call(Pred,H) -> True = [H|TT], filter(Pred,T,TT,False)
283		; False = [H|FF], filter(Pred,T,True,FF)).
284
285		:- public is_a_comment/3. % used for testing filter
286		:- assert_must_succeed((tools: filter(tools:is_a_comment('/*','*/'),['This comment ','/* comment */','will be ignored!'],R,Out),
287		R==['/* comment */'],Out==['This comment ','will be ignored!'])).
288		% checking whether an atom is a comment /* ... */
289		is_a_comment(Begin,End,Comment) :-
290		maplist(atom_codes,[Begin,End,Comment],[BL,EL,CL]),
291		prefix(CL,BL),suffix(CL,EL).
292
293		:- assert_must_succeed((tools:remove_variables([X,Y,Z],[Y],R),R==[X,Z])).
294		remove_variables(List,Vars,Remaining) :-
295		exclude(exact_member_rev(Vars),List,Remaining).
296		% a version of exact member with reversed parameters - usefull with
297		% higher-order functions
298		exact_member_rev(List,Member) :- exact_member(Member,List).
299
300		:- assert_must_succeed(tools:insert([],a,[a])).
301		:- assert_must_succeed(tools:insert([a,b,c,d],a,[a,b,c,d])).
302		:- assert_must_succeed(tools:insert([a,b,c,d],b,[a,b,c,d])).
303		:- assert_must_succeed(tools:insert([a,b,c,d],d,[a,b,c,d])).
304		:- assert_must_succeed(tools:insert([a,b,c,d],x,[a,b,c,d,x])).
305		insert([],X,[X]).
306		insert([H|T],X,R) :- (H=X -> R=[H|T] ; R=[H|R2],insert(T,X,R2)).
307
308
309		:- assert_must_succeed(tools:list_intersection([a,b,c,d],[d,f,b],[b,d])).
310
311		list_intersection([],_L,[]).
312		list_intersection([H|T],L,Res) :-
313	?	(remove(L,H,NL) -> (Res=[H|RR]) ; (Res=RR,NL=L)),
314		list_intersection(T,NL,RR).
315
316		insert_new([],X,[X]).
317		insert_new([H|T],X,R) :- (H=X -> fail ; R=[H|R2],insert_new(T,X,R2)).
318
319		:- assert_must_succeed(tools:disjoint_list_union([a,b,c,d],[e,f,g],[e,f,g,a,b,c,d])).
320		:- assert_must_fail(tools:disjoint_list_union([a,b,c,d],[d,f,b],_)).
321		:- assert_must_fail(tools:disjoint_list_union([a,b,c,d],[d,f,b],[d,f,b,a,c])).
322		disjoint_list_union([],L,L).
323		disjoint_list_union([H|T],L,Res) :- insert_new(L,H,L2), disjoint_list_union(T,L2,Res).
324
325		:- assert_must_succeed(tools:lists_are_disjoint([a,b,c,d],[e,f,g])).
326		:- assert_must_succeed(tools:lists_are_disjoint([a,b,c,d],[])).
327		:- assert_must_succeed(tools:lists_are_disjoint([],[e,f,g])).
328		:- assert_must_fail(tools:lists_are_disjoint([a,b,c,d],[e,f,g,d])).
329		lists_are_disjoint([],_).
330		lists_are_disjoint([H|T],List2) :- \+ member(H,List2), lists_are_disjoint(T,List2).
331
332		:- assert_must_succeed(tools:list_difference([a,b,c,d],[b,f,d],[a,c])).
333
334		list_difference([],_L,[]).
335		list_difference([H|T],L,Res) :-
336		(remove(L,H,NL) -> (Res=RR) ; (Res=[H|RR],NL=L)),
337		list_difference(T,NL,RR).
338
339		:- use_module(tools_strings,[string_concatenate/3]).
340		:- assert_must_succeed(( tools_strings:string_concatenate('5','.10',R), R=='5.10' )).
341
342
343
344
345
346		:- assert_must_succeed(tools:is_upper_case_name('GOODS')).
347		:- assert_must_succeed(tools:is_upper_case_name('ZZAA')).
348		:- assert_must_fail(tools:is_upper_case_name('capacity')).
349		:- assert_must_fail(tools:is_upper_case_name('PARAs')).
350
351		:- use_module(tools_strings,[safe_name/2]).
352		is_upper_case_name(Name) :-
353		safe_name(Name,AsciiList),
354		upper_case_list(AsciiList).
355
356		upper_case_list([]).
357		upper_case_list([H|T]) :- H >="A", H=<"Z", upper_case_list(T).
358
359
360
361		:- assert_must_succeed(tools:is_absolute_path('/aaaa/bbb/cc/d.app')).
362		:- assert_must_fail(tools:is_absolute_path('cc/d.app')).
363		:- assert_must_fail(tools:is_absolute_path('./cc/')).
364		is_absolute_path(Path) :-
365		atom_chars(Path,PathAscii),
366		PathAscii = ['/'|_]. % TO DO: add other rules for windows C: ...
367
368		:- assert_must_succeed(tools:get_parent_directory('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/')).
369		:- assert_must_succeed(tools:get_parent_directory('/aaaa/bbb/cc/','/aaaa/bbb/cc/')).
370		:- assert_must_succeed(tools:get_parent_directory('d.app','')).
371
372		get_parent_directory(Path,NewPath) :-
373		atom_chars(Path,PathAscii),
374		strip_last(PathAscii,[],[],New),
375		atom_chars(NewPath,New).
376
377		:- use_module(library(lists)).
378
379		strip_last([],ResSoFar,_,Res) :- reverse(ResSoFar,Res).
380		strip_last(['/'|Tail],ResSoFar,StripSoFar,Res) :- !,
381		append(['/'|StripSoFar],ResSoFar,NewRes),
382		strip_last(Tail,NewRes,[],Res).
383		strip_last([A|Tail],ResSoFar,StripSoFar,Res) :-
384		strip_last(Tail,ResSoFar,[A|StripSoFar],Res).
385
386		:- assert_must_succeed((tools:split_atom('ef,g',[','],R), R==[ef,g])).
387		:- assert_must_succeed((tools:split_atom('ef, g',[',',' '],R), R==[ef,g])).
388		:- assert_must_succeed((tools:split_atom('ab,cd,ef,g',[','],R), R==['ab','cd',ef,g])).
389		:- assert_must_succeed((tools:split_atom('ab,cd,ef;g',[',',';'],R), R==['ab','cd',ef,g])).
390
391		split_atom(Atom,SepList,SplitList) :-
392		atom_chars(Atom,ListAscii),
393		split2(ListAscii,SepList,SplitList).
394
395		split2([],_,R) :- !,R=[].
396		split2(List,Sep,Res) :- get_next_word(List,Sep,Word,Tail),!,
397		(Word=[] -> split2(Tail,Sep,Res)
398		; Res=[Atom|TA], atom_chars(Atom,Word), split2(Tail,Sep,TA)).
399
400		get_next_word([],_Sep,[],[]).
401		get_next_word([H|T],Sep,Word,Tail) :-
402		member(H,Sep) -> Word=[],Tail=T
403		; Word=[H|TR], get_next_word(T,Sep,TR,Tail).
404
405
406
407		:- assert_must_succeed((tools:split_complex_sep("ef,,g,h",",,",R), R==["ef","g,h"])).
408		% a version of split that allows longer seperators, % TO DO: make more efficient
409		split_complex_sep(L,Sep,[First|Rest]) :- append(Sep,LRest,SepR),
410		append(First,SepR,L),
411		!,
412		split_complex_sep(LRest,Sep,Rest).
413		split_complex_sep(H,_,[H]).
414
415
416		:- assert_must_succeed((tools:split_chars("ef,g",",",R), R==["ef","g"])).
417		:- assert_must_succeed((tools:split_chars("10",".",R), R==["10"])).
418		:- assert_must_succeed((tools:split_chars("",".",R), R==[""])).
419		:- assert_must_succeed((tools:split_chars("1.0",".",R), R==["1","0"])).
420		:- assert_must_succeed((tools:split_chars("1.",".",R), R==["1",""])).
421		:- assert_must_succeed((tools:split_chars(".1",".",R), R==["","1"])).
422
423		split_chars(List,Sep,Res) :- get_next_word_until_sep(List,Sep,Word,Tail),!,
424		Res=[Word|TA],
425		split_chars(Tail,Sep,TA).
426		split_chars(List,_,[List]).
427
428		get_next_word_until_sep([H|T],Sep,Word,Tail) :-
429		member(H,Sep) -> Word=[],Tail=T
430		; Word=[H|TR], get_next_word_until_sep(T,Sep,TR,Tail).
431
432		:- assert_must_succeed(tools:split_last('/aaaa/bbb/cc/d.app','/','/aaaa/bbb/cc','d.app')).
433		:- assert_must_succeed(tools:split_last('/aaaa/bbb/cc/d.app','.','/aaaa/bbb/cc/d','app')).
434		split_last(Atom, Sep, Head, Tail) :- \+ atom(Sep),!,
435		add_internal_error('Separator not an atom: ', split_last(Atom, Sep, Head, Tail)),fail.
436		split_last(Atom, Sep, Head, Tail) :- atom_chars(Sep,SepACodes),
437		split_last_lst(Atom,SepACodes,Head,Tail).
438
439
440		:- assert_must_succeed(tools:split_last_lst('/aaaa/bbb;cc/d.app',['/',';'],'/aaaa/bbb;cc','d.app')).
441		:- assert_must_succeed(tools:split_last_lst('/aaaa/bbb/cc/d.app',['.'],'/aaaa/bbb/cc/d','app')).
442		% a list version of split_last: obtains a list of sperator chars
443		split_last_lst(Atom, Seps, Head, Tail) :- \+ atom(Atom),!,
444		add_internal_error('First arg not an atom: ', split_last_lst(Atom, Seps, Head, Tail)),fail.
445		split_last_lst(Atom, Seps, Head, Tail) :-
446		atom_chars(Atom,ListAscii),
447		split_last2_lst(ListAscii,Seps,[],[],HeadA, TailA),
448		atom_chars(Head,HeadA), atom_chars(Tail,TailA).
449
450		split_last2_lst([],_,CurSplit,[_|Head],ResH,ResT) :-
451		reverse(CurSplit,ResT),
452		reverse(Head,ResH).
453	?	split_last2_lst([Sep|Tail],Seps,CurSplit,Head,ResH,ResT) :- member(Sep,Seps), % TO DO: use ord_member ?
454		!,
455		append([Sep|CurSplit],Head,NewHead),
456		split_last2_lst(Tail,Seps,[],NewHead,ResH,ResT).
457		split_last2_lst([H|Tail],Seps,CurSplit,Head,ResH,ResT) :-
458		split_last2_lst(Tail,Seps,[H|CurSplit],Head,ResH,ResT).
459
460
461
462		:- assert_must_succeed(tools:split_filename('/aaaa/bbb/cc/d.app','/aaaa/bbb/cc/d','app')).
463		:- assert_must_succeed((Z='/aaaa/bbb/cc/d',tools:split_filename(Z,R,X),X=='',R==Z)).
464
465		split_filename(Filename,Base,Ext) :-
466		(split_last(Filename,'.',Base,Ext) -> true ; Base=Filename,Ext='').
467
468
469		:- assert_must_succeed(tools:get_tail_filename('/aaaa/bbb/cc/d.app','d.app')).
470		:- assert_must_succeed(tools:get_tail_filename('\\aaaa\\bbb\\c\\d.app','d.app')).
471		:- assert_must_succeed(tools:get_tail_filename('d.app','d.app')).
472		:- assert_must_succeed(tools:get_tail_filename('/aaaa/bbb/cc/','')).
473		get_tail_filename(Path,Tail) :- compound(Path),!,
474		add_internal_error('Not a filename: ',get_tail_filename(Path,Tail)),
475		Tail=Path.
476		get_tail_filename(Path,Tail) :- (split_last_lst(Path, ['/','\\'], _, T) -> Tail=T ; Tail=Path).
477
478		:- assert_must_succeed(tools:get_modulename_filename('/aaaa/bbb/cc/d.app','d')).
479		:- assert_must_succeed(tools:get_modulename_filename('d.app','d')).
480		get_modulename_filename(Path,Module) :-
481		get_tail_filename(Path,Tail),
482		(split_last(Tail, '.', M, _) -> Module=M ; Module=other).
483
484
485		:- assert_must_succeed(get_filename_extension('/aaaa/bbb/cc/d.app','app')).
486		get_filename_extension(Path,Ext) :- split_filename(Path,_,Ext).
487
488		% also works if numbers passed (can happen by accident in test_runner ...)
489		% absolute_file_name('$a',X) generates a permission error
490		safe_absolute_file_name(F,AF,Options) :-
491		ensure_atom(F,A),
492		on_exception(error(permission_error(_,_,_),ERR),
493		absolute_file_name(A,AF,Options),
494		(format('*** Permission Error for absolute_file_name: ~w~n',[ERR]),AF=F)).
495
496		safe_absolute_file_name(F,AF) :- safe_absolute_file_name(F,AF,[]).
497
498
499
500		%*******************************************************************************
501		% remove_all(A,B,Result): Result is the list of elements of A which do not occur in B
502		remove_all([],_,[]).
503		remove_all([H|T],Remove,Result) :-
504	?	(member(H,Remove) -> !,Result = Rest ; Result = [H|Rest]),
505		remove_all(T,Remove,Rest).
506
507		%*******************************************************************************
508		% get_options/4 for parsing command line arguments
509
510		:- meta_predicate get_options(+,4,-,-).
511		:- meta_predicate get_options(+,4,-,-,0).
512
513		get_options(List,Pred,Options,Rest) :-
514		get_options(List,Pred,Options,Rest,halt).
515		get_options([],_,[],[],_).
516		get_options([X|T],Module:Recognised,Options,Args,HALTCMD) :-
517	?	( call(Module:Recognised,X,Opt,Values,Action)
518		->
519		( append(Values, Rest, T) -> true
520		; otherwise ->
521		length(Values,Len),
522		length(T,TLen),
523		(TLen < Len
524		-> format('Command ~w expects ~w argument(s); ~w provided.~n',[X,Len,TLen])
525		; format('~nInvalid argument(s) for option: ~w.~n',[X]) % will never happen ??
526		),
527		HALTCMD),
528		( call(Action) -> true
529		; otherwise ->
530		format('~nInvalid argument(s) for option ~w : ~w.~n',[X,Values]),
531		HALTCMD),
532		RT = Rest,
533		Options = [Opt|OT], Args = AT
534		; otherwise -> % option not recognised, keep in Args list (for probcli these are assumed to be files)
535		Options = OT, Args = [X|AT],
536		RT = T
537		),
538		get_options(RT,Module:Recognised,OT,AT,HALTCMD).
539
540		arg_is_number(Arg,Nr) :- number(Arg),!,Nr=Arg.
541		arg_is_number(Arg,Nr) :- atom(Arg),atom_codes(Arg,Str),safe_number_codes(Nr,Str),number(Nr).
542		arg_is_integer(Arg,Nr) :-
543		( append("-",SPos,Arg) -> % negative number
544		arg_is_number(SPos,Pos),
545		Nr is -Pos
546		; otherwise ->
547		arg_is_number(Arg,Nr)).
548
549		% utilities for command-line arguments
550
551		arg_is_number_or_wildcard('_',R) :- !, R=_.
552		arg_is_number_or_wildcard(Arg,N) :- arg_is_number(Arg,N).
553
554
555		:- use_module(error_manager,[add_warning/3]).
556		check_filename_arg(File,Command) :- tools:arg_is_number(File,_),!,
557		ajoin(['File argument to -',Command,' is a number: '],Msg),
558		add_warning(Command,Msg,File).
559		check_filename_arg(File,Command) :- atom(File),atom_concat('-',_,File),!,
560		ajoin(['File argument to -',Command,' starts with a hypen: '],Msg),
561		add_warning(Command,Msg,File).
562		check_filename_arg(_,_).
563
564
565		:- assert_must_succeed( tools:convert_list_into_pairs([a],a)).
566		:- assert_must_succeed( (tools:convert_list_into_pairs([a,b,c],R), R = ((a,b),c) )).
567
568		convert_list_into_pairs([X|T],Res) :- conv2(T,X,Res).
569		convert_list_into_pairs([],[]).
570		conv2([],X,X).
571		conv2([X|T],Acc,Res) :- conv2(T,(Acc,X),Res).
572
573		:- assert_must_succeed(( tools:convert_pairs_into_list([x],a,R), R==[a] )).
574		%:- assert_must_succeed(( b_interpreter:convert_pairs_into_list([x,y,z],((a,b),c),R), R == [a,b,c] )).
575		:- assert_must_succeed(( tools:convert_pairs_into_list([x,y,z],(a,(b,c)),R), R == [a,b,c] )).
576		:- assert_must_succeed(( tools:convert_pairs_into_list([x,y,z],A,B),nonvar(A),nonvar(B),A=((_,_),_),B=[_,_,_] )).
577
578		% the first argument just indicates the length of the list
579		convert_pairs_into_list([_],X,R) :- !,R=[X].
580		convert_pairs_into_list([_|Guide],(A,B),[A|Rest]) :-
581		convert_pairs_into_list(Guide,B,Rest).
582
583
584
585
586		/* ex: substitute(1, [1,2,3,4], 5, X). */
587		:- assert_must_succeed(( tools:substitute(1, [1,2,3,4], 5, X), X==[5,2,3,4])).
588		substitute(X,L,Y,Res) :- sub(L,X,Y,Res).
589		sub([],_,_,[]).
590		sub([H|T],X,Y,[SH|ST]) :-
591		(H=X -> SH=Y ; SH=H),
592		sub(T,X,Y,ST).
593
594
595		/* Checks if the argument is a list, but unlike is_list/1 it just
596		checks the head and does not iterate through the list */
597		is_list_simple([]).
598		is_list_simple([_|_]).
599
600		:- use_module(tools_strings,[ajoin/2, ajoin_with_sep/3, ajoin_with_limit/3]).
601		% tests are stored here to avoid cyclic module dependencies
602		:- assert_must_succeed((tools_strings: ajoin_with_sep([link,a,xa],'.',Text), Text == 'link.a.xa')).
603		:- assert_must_succeed((tools_strings: ajoin_with_sep([link],'.',Text), Text == 'link')).
604
605		:- assert_must_succeed((tools_strings: ajoin_with_limit(['A','B','C','D'],100,Text), Text == 'ABCD')).
606		:- assert_must_succeed((tools_strings: ajoin_with_limit(['A','B','C','D'],2,Text), Text == 'AB...')).
607
608
609		:- use_module(error_manager,[add_error_and_fail/3]).
610		safe_univ(Term,List) :- nonvar(Term),!,Term=..List.
611		safe_univ(Term,List) :- var(List), !,add_error_and_fail(tools,'Arguments to safe_univ (=..) both var:', safe_univ(Term,List)).
612		safe_univ(Term,List) :- %Term is a variable
613		prolog_flag(max_arity,MA), cut_off_list(List,MA,CL),
614		!, % avoid pending choice points
615		Term =.. CL.
616
617
618		% a version of safe_univ which does not remove args; just puts the extra arguments into the last arg
619
620		safe_univ_no_cutoff(Term,List) :- nonvar(Term),!,Term=..List.
621		safe_univ_no_cutoff(Term,List) :- var(List), !,
622		add_error_and_fail(tools,'Arguments to safe_univ (=..) both var:', safe_univ_no_cutoff(Term,List)).
623		safe_univ_no_cutoff(Term,List) :- %Term is a variable
624	?	prolog_flag(max_arity,MA), squash_list(List,MA,CL),
625		!, % avoid pending choice points
626		Term =.. CL.
627		squash_list([],_,[]).
628		squash_list([H|T],MA,R) :- (MA<3,T\=[] -> R=[H,T] ; R=[H|TR],MA1 is MA-1, squash_list(T,MA1,TR)).
629
630		safe_atom_chars(A,B,Loc) :-
631		on_exception(error(E1,E2),atom_chars(A,B),
632		(add_internal_error('atom_chars error: ',Loc:E1),
633		throw(error(E1,E2)))).
634
635		:- use_module(tools_strings,[atom_codes_with_limit/2, atom_codes_with_limit/3]).
636
637		safe_atom_codes(V,C) :- var(V),var(C),!,
638		add_internal_error('Variables in call: ',safe_atom_codes(V,C)), C='$VARIABLE$'.
639		safe_atom_codes(A,C) :-
640		on_exception(error(representation_error(max_atom_length),_),atom_codes(A,C),
641		(print(exception(max_atom_length)),nl,atom_codes_with_limit(A,1000,C))).
642
643		safe_number_codes(V,C) :- var(V),var(C),!,
644		add_internal_error('Variables in call: ',safe_number_codes(V,C)), C='$VARIABLE$'.
645		safe_number_codes(A,C) :-
646		on_exception(error(syntax_error(_N),_),number_codes(A,C),
647		( %print(9,syntax_error_in_number_codes(_N)),nl,
648		fail)). % in this case safe_number_codes fails ; we cannot convert the codes into a number
649
650		% for an identifier "x" and a number N, create a new identifier "x$N"
651		number_suffix(Id,N,FullId) :-
652		safe_atom_chars(Id,IdChars,number_suffix1),number_chars(N,NChars),
653		append(IdChars,['$'|NChars],FullIdChars),
654		safe_atom_chars(FullId,FullIdChars,number_suffix2).
655
656
657		:- assert_must_succeed(ensure_atom(19,'19')).
658		% ensure that numbers get converted to atoms:
659		ensure_atom(Var,A) :- var(Var),!, A='_'.
660		ensure_atom(N,Res) :- number(N),!,number_codes(N,C), atom_codes(A,C), Res=A.
661		ensure_atom(A,A).
662
663
664		:- use_module(tools_strings,[truncate_atom/3]).
665		:- assert_must_succeed((tools_strings:truncate_atom(abcd,100,Text), Text == 'abcd')).
666		:- assert_must_succeed((tools_strings:truncate_atom(abcd,2,Text), Text == 'ab...')).
667		:- assert_must_succeed((tools_strings:truncate_atom(abcd,0,Text), Text == '...')).
668
669
670		wrap_and_truncate_atom(Atom,LineLength,Limit,NewAtom) :- \+ atom(Atom),!,
671		add_internal_error('Argument to wrap_and_truncate_atom not atom: ',wrap_and_truncate_atom(Atom,LineLength,Limit,NewAtom)),
672		NewAtom=Atom.
673		wrap_and_truncate_atom(Atom,LineLength,Limit,NewAtom) :-
674		atom_codes(Atom,Codes),
675		wrap_and_truncate_codes(Codes,LineLength,LineLength,Limit,NewCodes,Chng),
676		(Chng=true -> atom_codes(NewAtom,NewCodes) ; NewAtom=Atom).
677
678		wrap_and_truncate_codes([],_,_,_,[],false).
679		wrap_and_truncate_codes([H|T],CharsOnLineCount,MaxLineLength,TotCount,Res,Chng) :-
680		(TotCount<1 -> Res = [46,46,46],Chng=true /* '...' */
681		; (CharsOnLineCount<1 -> Res=[92,110,H|TT], /* add newline \n */
682		TR=T, L1 is MaxLineLength, Chng=true
683		; H=92,T=[H2|T2] -> Res = [H,H2|TT], /* do not split escaped char */
684		TR=T2, L1 is CharsOnLineCount-1, Chng2=Chng
685		; Res = [H|TT], TR=T, L1 is CharsOnLineCount-1, Chng2=Chng),
686		TC1 is TotCount-1, wrap_and_truncate_codes(TR,L1,MaxLineLength,TC1,TT,Chng2)
687		).
688
689
690		cut_off_list([],_,[]).
691		cut_off_list([H|T],MA,R) :- (MA<2 -> R=['...'] ; R=[H|TR],MA1 is MA-1, cut_off_list(T,MA1,TR)).
692
693
694		% print_size_of_table counts the number of succeeded calls of the
695		% given predicate
696		get_calls_for_table(Module:P/N,Call) :- !,
697		functor(Call,P,N),
698		call(Module:Call).
699		get_calls_for_table(P/N,Call) :-
700		functor(Call,P,N),
701		call(Call).
702
703		:- volatile count/1.
704		:- dynamic count/1.
705		print_size_of_table(Pred) :- retractall(count(_)),
706		assert(count(0)),get_calls_for_table(Pred,_),inc_size_of_table,fail.
707		print_size_of_table(Pred) :-
708		print('% size of table for '), print(Pred), print(': '), count(X), print(X),nl.
709		inc_size_of_table :- retract(count(X)),X1 is X+1, assert(count(X1)).
710
711
712		safe_sort(Orig,A,B) :- var(A),!, add_error(tools,'Illegal call: ',mysort(Orig,A,B)),A=B.
713		safe_sort(_,A,B) :- sort(A,B).
714
715		safe_functor(Src,F,A,Term) :- var(F),var(A),var(Term),!,
716		add_internal_error('Illegal functor call: ',safe_functor(Src,F,A,Term)),
717		fail.
718		safe_functor(_,F,A,T) :- functor(F,A,T).
719
720
721		print_runtime :- statistics(runtime,[Tot,SinceLast]), print(' Total runtime: '), print(Tot),
722		print(' ms, since last: '), print(SinceLast), print(' ms'),nl.
723
724
725		start_ms_timer(timer(R,T,W)) :- statistics(runtime,[R,_]),
726		statistics(total_runtime,[T,_]),
727		statistics(walltime,[W,_]).
728		stop_ms_timer(T) :- stop_ms_timer(T,[runtime/RT,total_runtime/RTT,walltime/WT]),
729		format('% Runtime: ~w ms (with gc: ~w ms, walltime: ~w ms)~n',[RT,RTT,WT]).
730		stop_ms_timer_with_msg(T,Msg) :- stop_ms_timer(T,[runtime/RT,total_runtime/RTT,walltime/WT]),
731		statistics(walltime,[WE,_]),
732		format('% Runtime for ~w: ~w ms (with gc: ~w ms, walltime: ~w ms); time since start: ~w ms~n',[Msg,RT,RTT,WT,WE]).
733		stop_ms_walltimer_with_msg(T,Msg) :- stop_ms_timer(T,[runtime/_RT,total_runtime/_RTT,walltime/WT]),
734		format('% Walltime for ~w: ~w ms~n',[Msg,WT]).
735		stop_ms_timer(timer(R,T,W),[runtime/RT,total_runtime/RTT,walltime/WT]) :-!,
736		statistics(runtime,[RE,_]),
737		% These refer to CPU time used while executing, excluding time spent in memory management tasks or or in system calls.
738		statistics(total_runtime,[TE,_]),
739		% These refer to total CPU time used while executing, including memory management tasks such as garbage collection but excluding system calls.
740		statistics(walltime,[WE,_]),
741		% These refer to absolute time elapsed.
742		RT is RE-R, RTT is TE-T, WT is WE-W.
743		stop_ms_timer(X,Y) :-
744		add_internal_error('Illegal call: ', stop_ms_timer(X,Y)),
745		Y = [].
746		get_elapsed_walltime(timer(_R,_T,W),WTot) :-
747		statistics(walltime,[W2,_]), WTot is W2-W.
748
749		% a timer that measures backtracking times
750		:- dynamic last_bt_timer/2.
751		bt_start_ms_timer(Msg) :- retractall(last_bt_timer(Msg,_)),
752		start_ms_timer(T), assert(last_bt_timer(Msg,T)).
753		bt_start_ms_timer(Msg) :- retract(last_bt_timer(Msg,Timer)),
754		stop_ms_timer(Timer,[runtime/RT,total_runtime/_RTT,walltime/WT]),
755		format('% Runtime to FINALISE ~w: ~w ms (walltime: ~w ms)~n',[Msg,RT,WT]),
756		fail.
757
758
759		bt_stop_ms_timer(Msg) :-
760		retract(last_bt_timer(Msg,Last)),
761		stop_ms_timer(Last,[runtime/RT,total_runtime/_RTT,walltime/WT]),
762		format('% Runtime for SOLUTION for ~w: ~w ms (walltime: ~w ms)~n',[Msg,RT,WT]).
763		bt_stop_ms_timer(Msg) :- start_ms_timer(BT_Timer),
764		assert(last_bt_timer(Msg,BT_Timer)),
765		fail.
766		% ---------------------------
767
768
769		retract_with_statistics(Module,ListOfFacts) :-
770		nl,print('Retracting Facts'),nl,
771		get_memory_used(M),
772		print(' Memory usage: '),print_memory_used(M),nl,
773		retract_with_statistics(Module,ListOfFacts,M).
774
775		:- meta_predicate retract_all_count(0,-,-).
776
777		retract_with_statistics(_Module,[],_) :- nl,nl.
778		retract_with_statistics(Module,[Fact|T],Mem) :-
779		format('~w : ',[Fact]),
780		%retractall(Module:Fact),
781		retract_all_count(Module:Fact,0,Nr), format(' ~w facts : ',[Nr]),
782		get_memory_used(NewMem),
783		print_memory_used(NewMem),
784		print_memory_used_difference(Mem,NewMem),nl,
785		retract_with_statistics(Module,T,NewMem).
786
787		retract_all_count(Fact,Acc,Res) :- \+ (\+ (retract(Fact))),!, A1 is Acc+1, retract_all_count(Fact,A1,Res).
788		retract_all_count(_,R,R).
789
790		get_memory_used([M,PU]) :- garbage_collect,garbage_collect_atoms, get_memory_used_wo_gc([M,PU]).
791		get_memory_used_wo_gc([M,PU]) :- statistics(program,[PU,_]),statistics(memory_used,M).
792		print_memory_used_wo_gc :- get_memory_used_wo_gc(M), print_memory_used(M).
793		print_memory_used([M,PU]) :- print_mb(M), print(' ('), print_mb(PU), print(' program) ').
794		print_memory_used_difference([M1,_PU1],[NewM2,_PU2]) :- Diff is (M1)-(NewM2),
795		(Diff >= 0 -> print(' freed: '), print_bytes(Diff)
796		; print(' allocated: '), D2 is -(Diff), print_bytes(D2)),nl.
797		%print(' / '),Diff2 is (PU1)-(PU2), print_mb(Diff2).
798		print_bytes(X) :- (X<50000 -> print_kb(X) ; print_mb(X)).
799		print_mb(X) :- XMB is X / 1048576,
800		format(' ~3f MB',[XMB]).
801		print_kb(X) :- XKB is X / 1024,
802		format(' ~3f KB',[XKB]).
803
804		:- op(1150,fx,space_call).
805		:- meta_predicate space_call(0).
806		space_call(Call) :- get_memory_used(M1),
807		call(Call),
808		get_memory_used(M2),
809		print_memory_used(M2),
810		print_memory_used_difference(M1,M2),nl.
811
812		% ---------------------------
813
814		read_string_from_file(Filename,String) :-
815		open(Filename,read,S), % utf
816		read_string(S,String),
817		close(S).
818
819		% Encoding can be any value of text_encoding preference category: auto, 'ISO-8859-1', 'UTF-8', ...
820		read_string_from_file(Filename,auto,String) :- !, read_string_from_file(Filename,String).
821		read_string_from_file(Filename,Encoding,String) :-
822		open(Filename,read,S,[encoding(Encoding)]),
823		read_string(S,String),
824		close(S).
825
826		read_string(S,String) :-
827		get_code(S,C),!,
828		(C= -1
829		-> String = []
830		; String=[C|Rest],read_string(S,Rest)).
831
832		% ------------------------------
833
834		% encoding atoms for Latex:
835
836		latex_escape_atom(Atom,EscAtom) :- \+ atom(Atom),!,
837		add_internal_error('Cannot escape: ',latex_escape_atom(Atom,EscAtom)),
838		EscAtom=Atom.
839		latex_escape_atom(Atom,EscAtom) :-
840		atom_codes(Atom,Codes), latex_escape_codes(Codes,ECodes), atom_codes(EscAtom,ECodes).
841
842		latex_escape_codes([],[]).
843		%latex_escape_codes([92,C|T],[92,C|ET]) :- !, % already escaped
844		% latex_escape_codes(T,ET).
845		latex_escape_codes([C|T],[92,C|ET]) :- latex_escape_code(C),!, % 95 = _ underscore, 92 = \ backslash
846		latex_escape_codes(T,ET).
847		latex_escape_codes([Code|T],ET) :- translate_code(Code,String),
848		!,
849		append(String,ET2,ET),
850		latex_escape_codes(T,ET2).
851		latex_escape_codes([H|T],[H|ET]) :- latex_escape_codes(T,ET).
852
853		latex_escape_code(35). % #
854		latex_escape_code(36). % $
855		latex_escape_code(37). % %
856		latex_escape_code(38). % &
857		latex_escape_code(95). % 95 = _ underscore
858		latex_escape_code(123). % {
859		latex_escape_code(125). % }
860
861		translate_code(92,"\\textbackslash{}"). % \ % \textbackslash seems to work in both math and normal mode
862		translate_code(94,"\\textasciicircum{}"). % ^
863		translate_code(126,"\\textasciitilde{}"). % ~
864		%translate_code(126,"\\~{}"). % 126 = ~ tilde -> \~{} (\sim would be alternative in math mode)
865
866		% ------------------------------
867
868		% encoding atoms for B Strings:
869		% escape special characters so that we can output the string between quotes "..." and obtain a valid value
870
871		:- assert_must_succeed(tools:b_escape_string_atom('{"a"}','{\\"a\\"}')).
872
873		b_escape_string_atom(Atom,EscAtom) :- \+ atom(Atom),!,
874		add_internal_error('Cannot escape: ',b_escape_string_atom(Atom,EscAtom)),
875		EscAtom=Atom.
876		b_escape_string_atom(Atom,EscAtom) :-
877		atom_codes(Atom,Codes), b_string_escape_codes(Codes,ECodes), atom_codes(EscAtom,ECodes).
878
879		b_string_escape_codes([],[]).
880		b_string_escape_codes([92,C|T],[92,C|ET]) :- % 92 = \ backslash
881		\+ valid_backslash_escape(C), % we do not need to escape the \ in \x for example, but we need to escape in \n
882		!,
883		b_string_escape_codes(T,ET).
884		b_string_escape_codes([C|T],[92,EC|ET]) :- % 92 = \ backslash
885		b_escape_code(C,EC),!,
886		b_string_escape_codes(T,ET).
887		b_string_escape_codes([H|T],[H|ET]) :- b_string_escape_codes(T,ET).
888
889		% note currently only \" is supported by the Java parser; but this will change soon
890		b_escape_code(9,116). % tab, 116 = t
891		b_escape_code(10,110). % newline, 110 = n
892		b_escape_code(13,114). % return 114 = r
893		b_escape_code(34,34). % "
894		%b_escape_code(39,39). % ' % not necessary for "..." literals
895		b_escape_code(92,92). % \
896
897		% these are the escape codes the parser / ProB currently supports:
898		valid_backslash_escape(9).
899		valid_backslash_escape(10).
900		valid_backslash_escape(13).
901		valid_backslash_escape(34). % "
902		valid_backslash_escape(39). % '
903		valid_backslash_escape(92). % \
904
905		% ------------------------------
906
907
908		%%
909		% Escape is needed for &, \/, /\, ", ', etc.
910		% used mainly for dot output
911		% It seems dotty do not understand escapes, neither C style nor HTML style.
912		% Dot does render '&' correctly, no matter of escape.
913		%
914
915		print_escaped(Atom) :- string_escape(Atom,E), print(E).
916
917		:- use_module(library(lists), [
918		maplist/3,
919		scanlist/4]).
920
921		string_escape(Number, EscapedAtom):-
922		number(Number),!, number_chars(Number,C), atom_chars(EscapedAtom,C). % to detect when label=value
923		string_escape(Atom, EscapedAtom):-
924		atom(Atom),
925		atom_chars(Atom, Chars),
926		maplist(dot_string_escape_map, Chars, EscapedChars),
927		scanlist(x_atom_concat_rev, EscapedChars, '', EscapedAtom),!.
928		string_escape(Term, EscapedTerm):-
929		Term =.. [Fkt|Args],
930		string_escape(Fkt, EscapedFkt),
931		maplist(string_escape, Args, EscapedArgs),!,
932		EscapedTerm =.. [EscapedFkt|EscapedArgs].
933		string_escape(X,X).
934
935
936		x_atom_concat_rev(A,B,BA):-
937		atom_concat(B,A,BA).
938
939
940		html_escape(Number, EscapedAtom):-
941		number(Number),!, number_chars(Number,C), atom_chars(EscapedAtom,C). % to detect when label=value
942		html_escape(Atom, EscapedAtom):-
943		atom_chars(Atom, Chars),
944		maplist(html_string_escape_map, Chars, EscapedChars),
945		scanlist(x_atom_concat_rev, EscapedChars, '', EscapedAtom).
946
947
948		dot_string_escape_map('\n', '\\n').
949		dot_string_escape_map('\\', '\\\\').
950		dot_string_escape_map('"', '\\"').
951		dot_string_escape_map('\'', '\\\'').
952		dot_string_escape_map('{', '\\{'). % important if used inside dot records
953		dot_string_escape_map('}', '\\}'). % important if used inside dot records
954		dot_string_escape_map('|', '\\|'). % important if used inside dot records
955		dot_string_escape_map('>', '\\>'). % important if used inside dot records
956		dot_string_escape_map('<', '\\<'). % important if used inside dot records
957		dot_string_escape_map(A,B) :- x_string_escape_map(A,B).
958
959		html_string_escape_map('&', '&'). % michael: habe diese 3 Zeilen auskommentiert
960		html_string_escape_map('<', '<').
961		html_string_escape_map('>', '>').
962		html_string_escape_map(A,B) :- x_string_escape_map(A,B).
963
964		% this is the SICSTus encoding for Unicode either \octal_number\ or \xHexNumber\
965		% See Section 4.1.7.6 Escape Sequences in SICStus Manual (page 60)
966		x_string_escape_map('\344\', 'ä'). % a mit Umlaut
967		x_string_escape_map('\366\', 'ö'). % o mit Umlaut
968		x_string_escape_map('\374\', 'ü'). % u mit Umlaut
969		x_string_escape_map('\304\', 'Ä'). % A mit Umlaut
970		x_string_escape_map('\326\', 'Ö'). % O mit Umlaut
971		x_string_escape_map('\334\', 'Ü'). % U mit Umlaut
972
973		x_string_escape_map('\353\', 'ë'). % e mit Umlaut
974		x_string_escape_map('\313\', 'Ë'). % E mit Umlaut
975
976		x_string_escape_map('\350\', 'è'). % e mit Accent
977		x_string_escape_map('\351\', 'é').
978		x_string_escape_map('\352\', 'ê').
979		x_string_escape_map('\310\', 'È'). % E mit Accent
980		x_string_escape_map('\311\', 'É').
981		x_string_escape_map('\312\', 'Ê').
982
983		x_string_escape_map('\340\', 'à'). % a mit Accent
984		x_string_escape_map('\341\', 'á').
985		x_string_escape_map('\342\', 'â').
986		x_string_escape_map('\300\', 'À'). % A mit Accent
987		x_string_escape_map('\301\', 'Á').
988		x_string_escape_map('\302\', 'Â').
989
990		x_string_escape_map('\354\', 'ì'). % i mit Accent
991		x_string_escape_map('\355\', 'í').
992		x_string_escape_map('\356\', 'î').
993		x_string_escape_map('\314\', 'Ì'). % I mit Accent
994		x_string_escape_map('\315\', 'Í').
995		x_string_escape_map('\316\', 'Î').
996
997		x_string_escape_map('\362\', 'ò'). % o mit Accent
998		x_string_escape_map('\363\', 'ó').
999		x_string_escape_map('\364\', 'ô').
1000		x_string_escape_map('\322\', 'Ò'). % O mit Accent
1001		x_string_escape_map('\323\', 'Ó').
1002		x_string_escape_map('\324\', 'Ô').
1003
1004		x_string_escape_map('\347\', 'ç'). % cedille
1005		x_string_escape_map('\307\', 'Ç'). % Cedille
1006
1007		x_string_escape_map('\337\', 'ß'). % scharfes S (sz)
1008		x_string_escape_map('\361\', 'ñ'). % n with tilde
1009
1010		x_string_escape_map('\1661\', 'α'). % Greek
1011		x_string_escape_map('\1662\', 'β').
1012		x_string_escape_map('\1663\', 'γ').
1013		x_string_escape_map('\1664\', 'δ').
1014		x_string_escape_map('\1665\', 'ε').
1015		x_string_escape_map('\1666\', 'ζ').
1016		x_string_escape_map('\1667\', 'η').
1017		x_string_escape_map('\1670\', 'θ').
1018		x_string_escape_map('\1671\', 'ι').
1019		x_string_escape_map('\1672\', 'κ').
1020		x_string_escape_map('\1673\', 'λ').
1021		x_string_escape_map('\1674\', 'μ').
1022		x_string_escape_map('\1675\', 'ν').
1023		x_string_escape_map('\1676\', 'ξ').
1024		x_string_escape_map('\1677\', 'ο').
1025		x_string_escape_map('\1700\', 'π').
1026		x_string_escape_map('\1701\', 'ρ').
1027		x_string_escape_map('\1702\', 'ς').
1028		x_string_escape_map('\1703\', 'σ').
1029		x_string_escape_map('\1704\', 'τ').
1030		x_string_escape_map('\1705\', 'υ').
1031		x_string_escape_map('\1706\', 'φ').
1032		x_string_escape_map('\1707\', 'χ').
1033		x_string_escape_map('\1710\', 'ψ').
1034		x_string_escape_map('\1711\', 'ω').
1035
1036		% to do: add missing upper-case Greek letters:
1037		x_string_escape_map('\1624\', 'Δ').
1038		x_string_escape_map('\1630\', 'Θ').
1039		x_string_escape_map('\1633\', 'Λ').
1040		x_string_escape_map('\1636\', 'Ξ').
1041		x_string_escape_map('\1645\', 'Υ').
1042		x_string_escape_map('\1647\', 'Χ').
1043		x_string_escape_map('\1650\', 'Ψ').
1044		x_string_escape_map('\1651\', 'Ω').
1045
1046		% other symbols (converted using http://www.online-toolz.com/tools/unicode-html-entities-convertor.php )
1047		x_string_escape_map('\21242\','⊢'). %vdash turnstyle decimal: 8866
1048		x_string_escape_map('\21250\','⊨'). %models turnstyle decimal: 8872
1049		x_string_escape_map('\x21D4\','⇔'). % equivalence
1050		x_string_escape_map('\x21D2\','⇒'). % implication
1051		x_string_escape_map('\x2203\','∃'). % exists
1052		x_string_escape_map('\x2200\','∀'). % forall
1053		x_string_escape_map('·','·'). % dot used for quantifiers, ASCII 183
1054		x_string_escape_map('\x2227\','∧'). % conjunct
1055		x_string_escape_map('\x2228\','∨'). % disjunct
1056		x_string_escape_map('\xAC\','¬'). % negation
1057		x_string_escape_map('\x21A6\','↦'). % maplet |->
1058		x_string_escape_map('\x2286\','⊆'). % <: subseteq
1059		x_string_escape_map('\x222A\','∪'). % union
1060		x_string_escape_map('\x2229\','∩'). % intersection
1061		x_string_escape_map('\x2205\','∅'). % empty set
1062		x_string_escape_map('\x2260\','≠'). % not equal
1063		x_string_escape_map('\x2264\','≤'). % less equal
1064		x_string_escape_map('\x2265\','≥'). % greater equal
1065		x_string_escape_map('\x2124\','ℤ'). % Z (INTEGER)
1066		x_string_escape_map('\x2115\','ℕ'). % NATURAL
1067
1068		% Numbers without HTML translation: .. 8229
1069
1070		% translate unknown unicode chars to lozenge
1071		x_string_escape_map(Unicode, Result) :- atom(Unicode),
1072		atom_codes(Unicode,[Nr]), Nr>127,
1073		!,
1074		ajoin(['&#',Nr,';'],Result).
1075		%x_string_escape_map(Unicode, '◊') :-
1076		% atom(Unicode), atom_codes(Unicode,[Code]), Code>127.
1077		% format(user_output,'Uni: ~w ~n',[Unicode]).
1078		x_string_escape_map(X, X).
1079
1080		%
1081		% split_list(Pred,List,ListA,ListB):
1082		% List contains exactly the same elements as ListA and ListB
1083		% An element E is member of ListA iff Pred(E) is true and E is element of List.
1084		% An element E is member of ListB iff Pred(E) is false and E is element of List.
1085		:- meta_predicate split_list(1,?,?,?).
1086		:- meta_predicate split_list2(?,1,?,?).
1087		split_list(Pred,List,A,B) :-
1088		split_list2(List,Pred,A,B).
1089		split_list2([],_Pred,[],[]).
1090		split_list2([Elem|Rest],Pred,A,B) :-
1091	?	( call(Pred,Elem) -> A=[Elem|AR], B=BR
1092		; otherwise -> A=AR, B=[Elem|BR]),
1093		split_list2(Rest,Pred,AR,BR).
1094
1095		% a variation of split_list which also returns a list of predicate results
1096		% with re_split_list_idx(L,PredResult,A,B) : we can split another list using the same pattern
1097		:- meta_predicate split_list_idx(1,?,?,?,?).
1098		:- meta_predicate split_list_idx2(?,1,?,?,?).
1099		split_list_idx(Pred,List,PredResult,A,B) :-
1100		split_list_idx2(List,Pred,PredResult,A,B).
1101		split_list_idx2([],_Pred,[],[],[]).
1102		split_list_idx2([Elem|Rest],Pred,[PredTrue|PT],A,B) :-
1103		(call(Pred,Elem) -> PredTrue=true, A=[Elem|AR], B=BR
1104		; otherwise -> PredTrue=false, A=AR, B=[Elem|BR]),
1105		split_list_idx2(Rest,Pred,PT,AR,BR).
1106
1107
1108		re_split_list_idx([],[],[],[]).
1109		re_split_list_idx([Elem|Rest],[PredTrue|PT],A,B) :-
1110		(PredTrue=true -> A=[Elem|AR], B=BR
1111		; otherwise -> A=AR, B=[Elem|BR]),
1112		re_split_list_idx(Rest,PT,AR,BR).
1113
1114
1115		:- meta_predicate foldl(3,?,?,?).
1116		:- meta_predicate foldl2(?,3,?,?).
1117		just_for_unit_test_add(A,B,C) :- C is A+(10*B).
1118		:- assert_must_succeed(( foldl(just_for_unit_test_add,[],0,R), R==0 )).
1119		:- assert_must_succeed(( foldl(just_for_unit_test_add,[3,6,7,2,6],0,R), R==36726 )).
1120
1121		foldl(MPred,List,Start,Result) :-
1122	?	foldl2(List,MPred,Start,Result).
1123		foldl2([],_Pred,Value,Value).
1124		foldl2([Elem|Rest],MPred,OldValue,NewValue) :-
1125	?	call(MPred,Elem,OldValue,Value),
1126	?	foldl2(Rest,MPred,Value,NewValue).
1127
1128
1129		:- meta_predicate foldl(4,?,?,?,?).
1130		:- meta_predicate foldl2(?,4,?,?,?).
1131		just_for_unit_test_add2(A,B,C,D) :- D is 100*C+10*A+B.
1132		:- assert_must_succeed(( foldl(just_for_unit_test_add2,[],[],0,R), R==0 )).
1133		:- assert_must_succeed(( foldl(just_for_unit_test_add2,[3,6,7,2,6],[5,2,9,0,8],0,R), R==3562792068 )).
1134
1135		foldl(MPred,List,List1,Start,Result) :-
1136		foldl2(List,MPred,List1,Start,Result).
1137		foldl2([],_Pred,[],Value,Value).
1138		foldl2([Elem|Rest],MPred,[H1|R1],OldValue,NewValue) :-
1139		call(MPred,Elem,H1,OldValue,Value),
1140		foldl2(Rest,MPred,R1,Value,NewValue).
1141
1142		:- meta_predicate foldl(5,?,?,?,?,?).
1143		:- meta_predicate foldl2(?,5,?,?,?,?).
1144		just_for_unit_test_add3(A,B,C,D,E) :- E is D*1000+100*A+10*B+C.
1145		:- assert_must_succeed(( foldl(just_for_unit_test_add3,[],[],[],0,R), R==0 )).
1146		:- assert_must_succeed(( foldl(just_for_unit_test_add3,[3,6,7],[5,2,9],[4,1,0],0,R),
1147		R==354621790 )).
1148
1149		foldl(MPred,A,B,C,Start,Result) :-
1150		foldl2(A,MPred,B,C,Start,Result).
1151		foldl2([],_Pred,[],[],Value,Value).
1152		foldl2([Elem|Rest],MPred,[H1|R1],[H2|R2],OldValue,NewValue) :-
1153		call(MPred,Elem,H1,H2,OldValue,Value),
1154		foldl2(Rest,MPred,R1,R2,Value,NewValue).
1155
1156		:- assert_must_succeed(( average([2,4,8,10],Avg), D is abs(Avg-6),D<0.001 )).
1157		:- assert_must_succeed(( average([2],Avg), D is abs(Avg-2), D<0.001 )).
1158		average(List,Avg) :-
1159		length(List,N),sumlist(List,Sum),Avg is Sum/N.
1160
1161
1162		% assert_once works like assert, but checks if the fact has already been stored before and
1163		% will not store it a second time
1164		:- meta_predicate assert_once(0).
1165		assert_once(MPredicate) :-
1166		( call(MPredicate) -> true
1167		; otherwise -> assert(MPredicate)).
1168
1169
1170
1171		:- dynamic id_counter/1.
1172		unique_id(Prefix,Id) :-
1173		( id_counter(V) -> retractall(id_counter(_))
1174		; otherwise -> V is 0),
1175		N is V+1,
1176		assert( id_counter(N) ),
1177		number_codes(N,NCodes),
1178		append(Prefix,NCodes,ICodes),
1179		atom_codes(Id,ICodes).
1180
1181		% PROBPATH is the runtime search path for defintion files not found relative to the original machine.
1182		% By default this is the stdlib directory relative to the prob base dir.
1183		% The user can provide a list of : separated directories in the PROBPATH
1184		% environment variables which are prepended to the default path.
1185		get_PROBPATH(PROBPATH) :-
1186		environ('PROBPATH', CustomPATH),
1187		atom_length(CustomPATH, L),
1188		L > 0, !,
1189		get_path_separator(PS),
1190		get_stdlib_path(STDLIB), ajoin([CustomPATH, PS, STDLIB], PROBPATH).
1191
1192		get_PROBPATH(PROBPATH) :- get_stdlib_path(PROBPATH).
1193
1194		get_stdlib_path(STDLIB) :- runtime_application_path(Base), atom_concat(Base, '/stdlib', STDLIB).
1195
1196		% Platform specific path separator char
1197		map_path_separator(windows, ';').
1198		map_path_separator(_, ':').
1199
1200		get_path_separator(PS) :- host_platform(Platform), map_path_separator(Platform, PS), !.