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_strings,
7 [string_concatenate/3,
8 ajoin/2, ajoin_with_limit/3, ajoin_with_sep/3,
9 ajoin_path/3,
10 safe_name/2,
11 predicate_functor/3,
12 atom_codes_with_limit/2, atom_codes_with_limit/3,
13 truncate_atom/3,
14 atom_prefix/2, atom_suffix/2, atom_split/4,
15 match_atom/2, match_atom/3,
16 convert_cli_arg/2,
17 convert_to_number/2,
18 convert_atom_to_number/2,
19 get_hex_codes/2,
20 get_hex_bytes/2,
21 number_codes_min_length/3,
22 is_digit_code/1,
23 is_alphabetical_ascii_code/1,
24 is_simple_classical_b_identifier/1, is_simple_classical_b_identifier_codes/1,
25 is_composed_classical_b_identifier/1,
26 strip_newlines/2,
27 atom_tail_to_lower_case/2,
28 format_modified_info/2, format_datime_to_codes/2
29 ]).
30
31 :- use_module(module_information).
32
33 :- module_info(group,infrastructure).
34 :- module_info(description,'A few utilities on strings/atoms seperated out from tools.pl to avoid cyclic module dependencies.').
35
36 :- set_prolog_flag(double_quotes, codes).
37
38
39 %! string_concatenate(+X,+Y,-XY)
40 string_concatenate(X,Y,XY) :- atom(X),atom(Y),!, atom_concat(X,Y,XY).
41 string_concatenate(X,Y,XY) :- atom(X),number(Y),!,
42 % convert Y to atom, atom_concat is much faster than converting to codes list and back
43 number_codes(Y,YC), atom_codes(X,XC),
44 append(XC,YC,XYC),
45 atom_codes(XY,XYC).
46 string_concatenate(X,Y,XY) :-
47 safe_name(X,Xs),safe_name(Y,Ys),append(Xs,Ys,XYs),atom_codes(XY,XYs).
48
49 % tests are stored in tools.pl to avoid cyclic module dependencies
50 %:- assert_must_succeed((tools_strings: ajoin_with_sep([link,a,xa],'.',Text), Text == 'link.a.xa')).
51 %:- assert_must_succeed((tools_strings: ajoin_with_sep([link],'.',Text), Text == 'link')).
52
53 :- use_module(library(types), [illarg/3]).
54 ajoin_with_sep(List,Sep,Text) :- var(List),!,
55 illarg(var, ajoin_with_sep(List,Sep,Text), 1).
56 ajoin_with_sep(List,Sep,Text) :-
57 insert_sep(List,Sep,L2),
58 ajoin(L2,Text).
59
60 insert_sep([H1,H2|T],Sep,Res) :- !, Res= [H1,Sep|RT], insert_sep([H2|T],Sep,RT).
61 insert_sep(L,_Sep,L).
62
63
64 /* Concats a list of atoms, but checks if numbers or compound terms are
65 involved, which are converted to simple atoms */
66 ajoin(List,Text) :- var(List),!,
67 illarg(var, ajoin(List,Text), 1).
68 ajoin([Atom],Res) :- !, Res=Atom.
69 ajoin(ListOfAtoms,Atom) :- ajoin_with_limit(ListOfAtoms,10000000,Atom).
70 % atom_codes with list of 100000000 takes very long, with 10000000 a few seconds
71
72 % concats a directory with a tail file path
73 % checks if directory ends in slash and adds one if necessary and ensures only one / is present
74 % sicstus can deal paths with multiple /, so this is more for aesthetic reasons
75 ajoin_path(Directory,File,FullPath) :- \+ atom(Directory),!,
76 illarg(force_type(atom), ajoin_path(Directory,File,FullPath) , 1).
77 ajoin_path(Directory,File,FullPath) :- \+ atom(File),!,
78 illarg(force_type(atom), ajoin_path(Directory,File,FullPath) , 2).
79 ajoin_path(Directory,File,FullPath) :-
80 atom_codes(Directory,DC),
81 atom_codes(File,FC),
82 Sep = 0'/,
83 (FC=[Sep|FC2] -> FC2=FC ; FC2=[Sep|FC]),
84 (append(DC2,[Sep],DC) % directory ends in /
85 -> append(DC2,FC2,FullCodes)
86 ; append(DC,FC2,FullCodes)),
87 atom_codes(FullPath,FullCodes).
88
89
90 %safe_atom_concat(A,B,C,ExceptionOcc) :-
91 % catch(atom_concat(A,B,C),
92 % error(representation_error(max_atom_length),_),
93 % (print(exception(max_atom_length)),nl,A=C,ExceptionOcc=true)).
94
95 :- use_module(library(codesio),[write_to_codes/2]).
96
97 %toAtom(Number,Atom) :- number(Number),!,number_chars(Number,C),atom_chars(Atom,C).
98 %toAtom(Atom,Atom) :- atomic(Atom),!.
99 %toAtom(Term,Atom) :- write_to_codes(Term,Codes),safe_atom_codes(Atom,Codes).
100
101 toCodes(Number,Codes) :- number(Number),!,number_codes(Number,Codes).
102 toCodes(Atom,Codes) :- atomic(Atom),!,atom_codes(Atom,Codes).
103 toCodes(Term,Codes) :- write_to_codes(Term,Codes).
104
105
106 % match an atom with a term
107 % we want to match the atom 's(0)' with the term s(0)
108 match_atom(Atom,Term) :- atom(Term),!,Term=Atom.
109 match_atom(Atom,Term) :- atom_codes(Atom,AtomCodes), write_to_codes(Term,Codes),Codes=AtomCodes.
110
111 % version where atom_codes is precomputed for efficiency:
112 match_atom(Atom,_,Term) :- atom(Term),!,Term=Atom.
113 match_atom(_Atom,AtomCodes,Term) :- write_to_codes(Term,Codes),Codes=AtomCodes.
114
115
116 % a version of number codes with 0 padding at the left to achieve minimum length.
117 number_codes_min_length(Nr,Min,Codes) :- number_codes(Nr,C1), length(C1,Len),
118 pad_nrc(Len,Min,C1,Codes).
119 pad_nrc(L,Min,C,R) :- L >= Min,!, R=C.
120 pad_nrc(L,Min,C,[0'0 | RT]) :- L1 is L+1,
121 pad_nrc(L1,Min,C,RT).
122
123 % a copy of safe_atom_codes/2 from tools to avoid module dependency on error_manager
124 safe_atom_codes(V,C) :- var(V),var(C),!,
125 print_error('Variables in call: '),print_error(safe_atom_codes(V,C)),
126 C='$VARIABLE$'.
127 safe_atom_codes(A,C) :-
128 catch(atom_codes(A,C),
129 error(representation_error(max_atom_length),_),
130 (print(exception(max_atom_length)),nl,atom_codes_with_limit(A,1000,C))).
131
132 % will concatenate until the Limit is reached or exceeded; it may produce atoms longer than Limit
133 % (if first atom already longer than limit + it adds ...
134 %:- assert_must_succeed((tools: ajoin_with_limit(['A','B','C','D'],100,Text), Text == 'ABCD')).
135 %:- assert_must_succeed((tools: ajoin_with_limit(['A','B','C','D'],2,Text), Text == 'AB...')).
136
137
138 ajoin_with_limit(Atoms,Limit,Result) :-
139 ajoin_codes_with_limit(Atoms,Limit,Codes),
140 safe_atom_codes(Atom,Codes), Result=Atom.
141
142 %:- assert_must_succeed((tools: ajoin_codes_with_limit(['A','B','C','D'],100,Text), Text == "ABCD")).
143 ajoin_codes_with_limit([],_,[]).
144 ajoin_codes_with_limit([Atom|TAtoms],Limit,Res) :-
145 toCodes(Atom,AtomCodes),
146 add_codes(AtomCodes,TAtoms,Limit,Res).
147
148 add_codes([],TAtoms,Limit,Res) :- !, ajoin_codes_with_limit(TAtoms,Limit,Res).
149 add_codes(_,_,Limit,Res) :- Limit < 1, !, Res = "...".
150 add_codes([H|T],TAtoms,Limit,[H|TR]) :- L1 is Limit-1,
151 add_codes(T,TAtoms,L1,TR).
152
153
154
155 :- use_module(tools_printing,[print_error/1]).
156 safe_name([], "[]") :- !. % [] is not an atom on SWI-Prolog!
157 safe_name(X,N) :- atom(X),!, atom_codes(X,N).
158 safe_name(X,N) :- number(X),!, number_codes(X,N).
159 safe_name(X,N) :- var(X),!, N="var".
160 safe_name(lambda_res(X),[114,101,115,95|N]) :- !, atom_codes(X,N).
161 safe_name(X,N) :- functor(X,F,_),atom_codes(F,N), print_error(non_atomic_in_safe_name(X)).
162
163
164 predicate_functor(X,F,N) :- var(X),!, print_error(var_in_predicate_functor),F='$VAR',N=0.
165 predicate_functor(_Module:Pred,F,N) :- !,predicate_functor(Pred,F,N).
166 predicate_functor(P,F,N) :- functor(P,F,N).
167
168
169
170 atom_codes_with_limit(A,C) :-
171 catch(
172 atom_codes(A,C),
173 error(representation_error(max_atom_length),_),
174 (print(exception(max_atom_length)),nl,atom_codes_with_limit(A,1000,C))).
175
176
177 atom_codes_with_limit(A,Limit,Codes) :- var(A), Limit >= 0, !,
178 truncate_codes(Codes,Limit,TCodes,_),
179 atom_codes(A,TCodes).
180 %atom_codes_with_limit(A,Limit,Codes) :- compound(A),!, % should we catch this error?
181 atom_codes_with_limit(A,Limit,Codes) :- Limit < 1, !, atom_codes(A,Codes).
182 atom_codes_with_limit(A,Limit,Codes) :- atom_codes(A,Codes1),
183 truncate_codes(Codes,Limit,Codes1,_).
184
185
186 truncate_codes([],_,[],false).
187 truncate_codes([H|T],Count,Res,Trunc) :-
188 Count<1 -> Res = [46,46,46],Trunc=true /* '...' */
189 ; Res = [H|TT], C1 is Count-1, truncate_codes(T,C1,TT,Trunc).
190
191 %:- assert_must_succeed((tools_strings:truncate_atom(abcd,100,Text), Text == 'abcd')).
192 %:- assert_must_succeed((tools_strings:truncate_atom(abcd,2,Text), Text == 'ab...')).
193 %:- assert_must_succeed((tools_strings:truncate_atom(abcd,0,Text), Text == '...')).
194 % TO DO: could be made more efficient by using something like sub_atom(Atom,0,Limit,_,NewAtom)
195 truncate_atom(Atom,Limit,NewAtom) :-
196 atom_codes(Atom,Codes),
197 truncate_codes(Codes,Limit,TCodes,Trunc),
198 (Trunc=true -> atom_codes(NewAtom,TCodes) ; NewAtom=Atom).
199
200
201 %atom_prefix(_,Atom) :- \+ atom(Atom),!, trace,fail.
202 atom_prefix(Prefix,Atom) :-
203 sub_atom(Atom,0,_,_,Prefix). % instead of atom_concat(Prefix,_,Atom)
204
205 %atom_suffix(_,Atom) :- \+ atom(Atom),!, trace,fail.
206 atom_suffix(Suffix,Atom) :-
207 sub_atom(Atom,_,_,0,Suffix). % instead of atom_concat(_,Suffix,Atom)
208
209 % Atom can be split into Prefix.Sep.Suffix
210 atom_split(Prefix,Sep,Suffix,Atom) :-
211 atom_concat(Prefix,Suffix1,Atom),
212 atom_concat(Sep,Suffix,Suffix1).
213
214 convert_cli_arg(PrefVal,Value) :- compound(PrefVal),!,Value=PrefVal.
215 convert_cli_arg(Atom,Value) :-
216 convert_atom_to_number(Atom,Nr),!, /* convert '12' to 12 */
217 Value=Nr.
218 convert_cli_arg(V,V).
219
220 convert_to_number(Nr,Res) :- number(Nr),!,Res=Nr.
221 convert_to_number(Atom,Nr) :- convert_atom_to_number(Atom,Nr).
222
223 convert_atom_to_number(Atom,Nr) :-
224 atom(Atom), atom_codes(Atom,C),
225 catch(number_codes(Nr,C),
226 error(syntax_error(_N),_),
227 % in this case safe_number_codes fails ; we cannot convert the codes into a number
228 fail).
229
230
231 % detect simple ASCII classical B identifiers accepted by the parser
232 is_simple_classical_b_identifier(Atom) :- atom_codes(Atom,Codes),
233 is_simple_classical_b_identifier_codes(Codes).
234 is_simple_classical_b_identifier_codes(Codes) :-
235 Codes = [Code|T],
236 ? is_valid_id_letter_code(Code),!,
237 legal_id_aux(T).
238
239 legal_id_aux([]).
240 legal_id_aux([0'$,0'0]) :- !. % only $0 allowed
241 ?legal_id_aux([Code|T]) :- legal_id_code(Code),!,legal_id_aux(T).
242
243 legal_id_code(0'_).
244 % FIXME Primes should only be allowed at the end of the identifier, not in the middle!
245 legal_id_code(0'\').
246 legal_id_code(0x2032). % Unicode prime
247 legal_id_code(C) :- is_digit_code(C).
248 ?legal_id_code(C) :- is_valid_id_letter_code(C).
249
250 is_digit_code(Code) :- Code >= 48, Code =< 57. % 0-9
251
252 is_alphabetical_ascii_code(Code) :- Code >= 65,
253 ( Code =< 90 -> true % A-Z
254 ; Code >= 97, Code =< 122). % a-z
255
256 is_greek_lower_case(Code) :- Code >= 945, % alpha
257 Code =< 1017. % omega
258 is_greek_upper_case(Code) :- Code >= 916, % Alpha
259 Code =< 937. % Omega
260
261 % partially taken from BParser.scc: unicode_letter definition from java-1.7.sablecc
262 is_umlaut_code(Code) :- Code < 0xc0, !, fail.
263 is_umlaut_code(Code) :- Code >= 0xc0, Code =< 0xd6. % [0x00c0..0x00d6] in BParser.scc )
264 is_umlaut_code(Code) :- Code >= 0xd8, Code =< 0xf6. % [0x00c0..0x00d6] in BParser.scc
265 is_umlaut_code(Code) :- Code >= 0xf8, Code =< 0x01f5. % [0x00f8..0x01f5] in BParser.scc
266 is_umlaut_code(Code) :- Code >= 0x01fa, Code =< 0x0217.
267 is_umlaut_code(Code) :- Code >= 0x0401, Code =< 0x040c. % Cyrillic 0x0401..0x040c] + [0x040e..0x044f]
268 is_umlaut_code(Code) :- Code >= 0x040e, Code =< 0x044f.
269 is_umlaut_code(Code) :- Code >= 0x0451, Code =< 0x045c. % [0x0451..0x045c] + [0x045e..0x0481]
270 is_umlaut_code(Code) :- Code >= 0x045e, Code =< 0x0481.
271 % TO DO: add more
272
273 is_greek_lambda_code(955). % special treatment as it is used as an operator
274
275 is_valid_id_letter_code(Code) :- is_alphabetical_ascii_code(Code).
276 is_valid_id_letter_code(Code) :- is_greek_lower_case(Code), % accepted by ProB, but not by Atelier-B
277 \+ is_greek_lambda_code(Code).
278 is_valid_id_letter_code(Code) :- is_greek_upper_case(Code). % accepted by ProB, but not by Atelier-B
279 is_valid_id_letter_code(Code) :- is_umlaut_code(Code). % accepted by ProB, but not by Atelier-B
280
281 is_composed_classical_b_identifier(Atom) :- atom_codes(Atom,Codes),
282 Codes = [Code|T],
283 is_valid_id_letter_code(Code), !,
284 legal_comp_id_aux(T).
285
286 legal_comp_id_aux([]).
287 legal_comp_id_aux([0'$,0'0]). % only $0 allowed
288 legal_comp_id_aux([0'. , Code |T]) :- !, % a dot which must be followed by a new legal id
289 is_valid_id_letter_code(Code), !, legal_comp_id_aux(T).
290 legal_comp_id_aux([Code|T]) :- legal_id_code(Code), !, legal_comp_id_aux(T).
291
292 % strip newlines and replace by space
293 strip_newlines(Atom,SAtom) :- atom_codes(Atom,Codes), strip_aux(Codes,SC), atom_codes(SAtom,SC).
294
295 strip_aux([],R) :- !,R=[].
296 strip_aux([10|T],R) :- !, strip_aux(T,R).
297 strip_aux([13|T],[32|R]) :- !, strip_aux(T,R).
298 strip_aux([H|T],[H|R]) :- !,strip_aux(T,R).
299
300 :- use_module(library(lists),[maplist/3]).
301
302 % transform upper case to lower case, except for first letter
303 atom_tail_to_lower_case(ATOM_uc,Atom_lc) :-
304 atom_codes(ATOM_uc,[First|TC]),
305 maplist(simple_lowcase,TC,TC2),
306 atom_codes(Atom_lc,[First|TC2]).
307
308 simple_lowcase(H,R) :- 0'A =< H, H =< 0'Z, !, R is H+0'a-0'A.
309 simple_lowcase(Code,Code).
310
311
312 % ---------- hex utilities: to do move to tools ?
313
314
315 %:- assert_must_succeed(tools_strings: get_hex_codes(255,"ff").
316 get_hex_codes(0,Chars) :- !, Chars="0".
317 get_hex_codes(Nr,Chars) :- get_hex_codes(Nr,[],Chars).
318
319 get_hex_codes(0,Acc,R) :- !, R=Acc.
320 get_hex_codes(Nr,Acc,R) :-
321 DigNr is Nr mod 16,
322 get_hex_code(DigNr,Char),
323 N1 is Nr // 16,
324 get_hex_codes(N1,[Char|Acc],R).
325
326 %:- assert_must_succeed(tools_strings: get_hex_bytes([255,3],"ff03")).
327 % use for converting output of sha hash library:
328 get_hex_bytes([],[]).
329 get_hex_bytes([Byte|T],[C1,C2|HT]) :- get_hex_byte(Byte,C1,C2), get_hex_bytes(T,HT).
330
331 get_hex_byte(Byte,C1,C2) :-
332 N1 is Byte // 16, N2 is Byte mod 16,
333 get_hex_code(N1,C1), get_hex_code(N2,C2).
334 get_hex_code(Nr,Digit) :- Nr<10,!, Digit is Nr+48. % "0" = [48]
335 get_hex_code(Nr,Digit) :- Nr<16,!, Digit is Nr+87. % "A" = [65], "a" = [97]
336
337 % ---------------------- date utilities
338
339 % a way to print modify_localtime
340 format_modified_info(Stream,ModLocTime) :-
341 format(Stream,' (modified on ',[]),
342 format_datime(Stream,ModLocTime),
343 format(Stream,')~n',[]).
344
345 format_datime(Stream,datime(Yr,Mon,Day,Hr,Min,_Sec)) :-
346 number_codes_min_length(Min,2,MC),!,
347 format(Stream,'~w/~w/~w at ~w:~s',[Day,Mon,Yr,Hr,MC]).
348 format_datime(Stream,Time) :-
349 format(Stream,'<<?? ~w ??>>',Time).
350
351 :- use_module(library(codesio),[format_to_codes/3]).
352
353 format_datime_to_codes(datime(Yr,Mon,Day,Hr,Min,_Sec),Codes) :-
354 number_codes_min_length(Min,2,MC),!,
355 format_to_codes('~w/~w/~w at ~w:~s',[Day,Mon,Yr,Hr,MC],Codes).
356 format_datime_to_codes(Time,Codes) :-
357 format('<<?? ~w ??>>',Time,Codes).
358