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