1 % (c) 2012-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 :- module(kernel_strings, [empty_b_string/1,
6 b_string_length/2,
7 b_string_to_int_wf/4,
8 int_to_b_string/2,
9 int_to_dec_b_string/3,
10 real_to_dec_b_string/4,
11 b_string_is_int/2,
12 b_string_is_number/2,
13 b_string_is_decimal/2,
14 b_string_is_alphanumerical/2,
15 to_b_string/2,
16 to_b_string_with_options/3,
17 b_string_append_wf/4,
18 b_concat_sequence_of_strings_wf/4,
19 b_string_reverse_wf/3,
20 b_string_split_wf/4,
21 b_string_join_wf/5,
22 b_string_chars/2,
23 b_string_codes/2,
24 b_string_to_uppercase/2,
25 b_string_to_lowercase/2,
26 b_string_equal_case_insensitive/3,
27 b_substring_wf/6,
28 b_string_replace/4,
29 format_to_b_string/3, convert_b_sequence_to_list_of_atoms/3,
30
31 % utilities:
32 split_atom_string/3,
33 generate_code_sequence/3
34 ]).
35
36 % Strings in ProB are represented by terms of the form string(PrologAtom)
37
38 :- use_module(module_information,[module_info/2]).
39 :- module_info(group,kernel).
40 :- module_info(description,'This module provides (external) functions to manipulate B strings.').
41
42 :- use_module(error_manager).
43 :- use_module(self_check).
44 :- use_module(library(lists)).
45 :- use_module(custom_explicit_sets,[expand_custom_set_to_list/4, expand_custom_set_to_list_wf/5,
46 is_set_value/2, expand_custom_set_to_list_gg/4,
47 try_expand_and_convert_to_avl/2]).
48 :- use_module(kernel_objects,[greater_than_equal/2]).
49 :- use_module(probsrc(tools_strings),[ajoin/2]).
50 :- use_module(kernel_tools,[ground_value_check/2]).
51
52 :- set_prolog_flag(double_quotes, codes).
53
54 empty_b_string(string('')).
55
56 :- use_module(kernel_objects,[exhaustive_kernel_succeed_check/1,exhaustive_kernel_fail_check/1,
57 exhaustive_kernel_check_wf/2,exhaustive_kernel_fail_check_wf/2]).
58
59 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_length(string(''),int(0)))).
60 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_length(string('a'),int(1)))).
61 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_length(string('aa'),int(2)))).
62 :- assert_must_succeed(exhaustive_kernel_fail_check(kernel_strings:b_string_length(string('a'),int(0)))).
63 :- assert_must_succeed(exhaustive_kernel_fail_check(kernel_strings:b_string_length(string('a'),int(2)))).
64
65
66 :- block b_string_length(-,-).
67 b_string_length(SA,int(L)) :-
68 greater_than_equal(int(L),int(0)),
69 string_len2(SA,L).
70 :- block string_len2(-,-).
71 string_len2(SA,L) :-
72 L==0,!,
73 empty_b_string(SA).
74 string_len2(string(A),L) :-
75 string_len3(A,L).
76 :- block string_len3(-,-).
77 string_len3(A,L) :-
78 L==0,
79 !,
80 empty_b_string_atom(A).
81 % in case A is not known and L=1 we could enumerate chars ??
82 string_len3(A,L) :-
83 string_len4(A,L).
84 :- block string_len4(-,?).
85 string_len4(A,L) :-
86 atom_length(A,LL), LL=L. % delay unification due to bug in SICStus atom_length
87 % bug in SICStus: dif(X,1), atom_length(a,X) succeeds in 4.2.0 and 4.2.1
88
89
90 % ----------------------------
91
92
93 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_to_int_wf(string('11'),int(11),unknown,WF),WF)).
94 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(kernel_strings:b_string_to_int_wf(string('11'),int(1),unknown,WF),WF)).
95 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(kernel_strings:b_string_to_int_wf(string('1'),int(11),unknown,WF),WF)).
96 :- assert_must_fail((kernel_strings:b_string_to_int_wf(S,int(11),u,WF),kernel_strings:b_string_to_int_wf(S,int(12),u,WF))).
97
98 :- block b_string_to_int_wf(-,-,?,?).
99 b_string_to_int_wf(string(S),int(I),Span,WF) :-
100 string_to_int2(S,I,Span,WF).
101
102 :- block string_to_int2(-,-,?,?).
103 string_to_int2(S,Res,Span,WF) :- var(S), % we know the number; we cannot construct the string as leading spaces/0s are ok
104 % with an injective string_to_int conversion we could invert the function
105 !,
106 frozen(S,Goal),
107 (incompatible_goal(Goal,S,Res) ->
108 fail ; true),
109 strint_to_int3(S,Res,Span,WF).
110 string_to_int2(S,Res,Span,WF) :- strint_to_int3(S,Res,Span,WF).
111
112 :- use_module(kernel_waitflags,[add_wd_error_set_result/6]).
113 :- block strint_to_int3(-,?,?,?).
114 strint_to_int3(S,Res,Span,WF) :-
115 atom_codes(S,C),
116 catch(
117 integer_number_codes(C,S,Res,Span,WF),
118 error(syntax_error(_),_),
119 add_wd_error_set_result('Could not convert string to integer: ',S,Res,0,Span,WF)).
120 %add_error_and_fail(external_functions,'### Could not convert string to integer: ',S)),
121
122 integer_number_codes(C,S,Res,Span,WF) :-
123 number_codes(Num,C),
124 (integer(Num) -> Res=Num
125 ; %add_error_and_fail(external_functions,'### String represents a floating point number (expected integer): ',S)).
126 add_wd_error_set_result('String represents a floating point number (expected integer): ',S,Res,0,Span,WF)).
127
128 % check if another pending co-routine transforms the same string into another number
129 incompatible_goal((A,B),S,Res) :-
130 (incompatible_goal(A,S,Res) -> true ; incompatible_goal(B,S,Res)).
131 incompatible_goal(kernel_strings:strint_to_int3(S2,Res2,_,_),S,Res) :-
132 number(Res2),
133 S==S2, Res2 \= Res.
134
135 % ----------------------------
136
137 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_b_string(int(0),string('0')))).
138 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_b_string(int(10),string('10')))).
139 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_b_string(int(-10),string('-10')))).
140 :- assert_must_succeed(exhaustive_kernel_fail_check(kernel_strings:int_to_b_string(int(0),string('1')))).
141 :- assert_must_succeed(exhaustive_kernel_fail_check(kernel_strings:int_to_b_string(int(1),string('01')))).
142
143 % difference to string_to_int: do not throw error when string cannot be converted to integer
144
145 :- block int_to_b_string(-,?).
146 int_to_b_string(int(I),S) :- int_to_string2(I,S).
147
148 :- block int_to_string2(-,?).
149 int_to_string2(Num,Res) :-
150 number_codes(Num,C),
151 atom_codes(S,C), Res=string(S).
152
153
154 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_int(string('0'),pred_true))).
155 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_int(string('-10'),pred_true))).
156 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_int(string('1267650600228229401496703205376'),pred_true))). %// 2^100
157 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_int(string('1.0'),pred_false))).
158 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_int(string(''),pred_false))).
159 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_int(string('-'),pred_false))).
160
161 :- block b_string_is_int(-,?).
162 b_string_is_int(string(S),Res) :-
163 string_is_int2(S,Res).
164
165 :- block string_is_int2(-,?).
166 string_is_int2(S,Res) :-
167 atom_codes(S,C),
168 catch((
169 number_codes(Num,C),
170 (integer(Num) -> Res=pred_true ; Res=pred_false)
171 ), error(syntax_error(_),_), Res=pred_false).
172
173 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_number(string('0'),pred_true))).
174 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_number(string('-10'),pred_true))).
175 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_number(string('1267650600228229401496703205376'),pred_true))). %// 2^100
176 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_number(string('1.0'),pred_true))).
177 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_number(string(''),pred_false))).
178 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_number(string('-'),pred_false))).
179
180 :- block b_string_is_number(-,?).
181 b_string_is_number(string(S),Res) :-
182 string_is_number2(S,Res).
183
184 :- block string_is_number2(-,?).
185 string_is_number2(S,Res) :-
186 atom_codes(S,C),
187 catch((
188 number_codes(_Num,C),
189 Res=pred_true
190 ), error(syntax_error(_),_), Res=pred_false).
191
192
193 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('0.0'),pred_true))).
194 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('-10.2'),pred_true))).
195 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('1267650600228229401496703205376.000'),pred_true))). %// 2^100
196 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('01.10'),pred_true))).
197 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('1.99'),pred_true))).
198 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('1'),pred_false))).
199 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('.99'),pred_false))).
200 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('.'),pred_false))).
201 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string(''),pred_false))).
202 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_decimal(string('-'),pred_false))).
203
204 % test if we have a pure decimal number, with leading and trailing digits around the dot
205 :- block b_string_is_decimal(-,?).
206 b_string_is_decimal(string(S),Res) :-
207 string_is_decimal2(S,Res).
208
209 :- block string_is_decimal2(-,?).
210 string_is_decimal2(S,Res) :-
211 atom_codes(S,C),
212 (is_dec_nr(C) -> Res=pred_true ; Res=pred_false).
213
214 is_dec_nr([H|T]) :- is_digit(H),!,is_dec_nr2(T).
215 is_dec_nr([45,H|T]) :- % 45 = minus
216 is_digit(H),is_dec_nr2(T).
217
218 is_dec_nr2([H|T]) :- is_digit(H),!,is_dec_nr2(T).
219 is_dec_nr2([46,D|T]) :- % 46 = dot
220 is_digit(D),
221 is_dec_nr3(T).
222
223 is_dec_nr3([]).
224 is_dec_nr3([H|T]) :- is_digit(H),is_dec_nr3(T).
225
226
227 is_digit(X) :- X>=48, X=<57.
228
229 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(0),int(1),string('0.0')))).
230 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(21),int(1),string('2.1')))).
231 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(121),int(2),string('1.21')))).
232 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(101),int(2),string('1.01')))).
233 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(-101),int(2),string('-1.01')))).
234 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(-101),int(3),string('-0.101')))).
235 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(121),int(0),string('121')))).
236 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:int_to_dec_b_string(int(121),int(-2),string('12100')))).
237
238 :- block int_to_dec_b_string(-,?,?), int_to_dec_b_string(?,-,?).
239 int_to_dec_b_string(int(I),int(Prec),S) :- int_to_dec_string2(I,Prec,S).
240
241 :- block int_to_dec_string2(-,?,?), int_to_dec_string2(?,-,?).
242 int_to_dec_string2(I,Prec,String) :-
243 Prec=<0,
244 !,
245 IP is I * (10^abs(Prec)),
246 int_to_string2(IP,String).
247 int_to_dec_string2(I,Prec,String) :- %Prec>0,
248 PowTen is 10^Prec,
249 IntVal is I // PowTen,
250 number_codes(IntVal,IVC),
251 ((IntVal=0, I<0) -> Prefix = [45|IVC] % need to add leading -
252 ; Prefix = IVC),
253 DecVal is abs(I) mod PowTen,
254 number_codes(DecVal,DVC),
255 length(DVC,Digits),
256 NrZeros is Prec-Digits,
257 length(Zeros,NrZeros),
258 maplist(is_zero,Zeros),
259 append(Zeros,DVC,Suffix),
260 append(Prefix,[46|Suffix],Codes), % 46 is the dot .
261 atom_codes(Atom,Codes),
262 String = string(Atom).
263
264 is_zero(48). % ascii code of zero 0
265 % -------------------
266
267
268 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:real_to_dec_b_string(term(floating(1.05)),int(2),string('1.05'),unkown))).
269 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:real_to_dec_b_string(term(floating(1.01)),int(3),string('1.010'),unkown))).
270 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:real_to_dec_b_string(term(floating(1.05)),int(1),string('1.1'),unkown))).
271
272 :- use_module(probsrc(kernel_reals),[is_real/2]).
273 :- use_module(library(codesio), [with_output_to_codes/4]).
274
275 :- block real_to_dec_b_string(-,?,?,?), real_to_dec_b_string(?,-,?,?).
276 real_to_dec_b_string(Real,int(Prec),Res,Span) :-
277 is_real(Real,RealNr),
278 real_to_dec_b_string2(RealNr,Prec,Res,Span).
279
280 :- block real_to_dec_b_string2(-,?,?,?), real_to_dec_b_string2(?,-,?,?).
281 real_to_dec_b_string2(RealNr,Prec,Res,Span) :-
282 Prec<0,!,
283 add_error(kernel_strings,'Precision must not be negative:',Prec,Span),
284 real_to_dec_b_string2(RealNr,0,Res,Span).
285 real_to_dec_b_string2(RealNr,Prec,Res,_) :-
286 number_codes(Prec,PC),
287 append(["~",PC,"f"],FormatStr), atom_codes(Format,FormatStr),
288 % print(f(Format)),nl, write_term(RealNr,[float_format(Format)]),
289 with_output_to_codes(
290 %write_term(Stream,RealNr,[float_format(Format)]), % SWI Prolog does not recognise the float_format option
291 format(Stream,Format,[RealNr]), % SICStus and SWI differ when Precision is 0; SICStus prints .0 SWI does not
292 Stream,
293 Codes, []),
294 atom_codes(ResStr,Codes),
295 Res=string(ResStr).
296
297 % use write_term to convert float to decimal string:
298 % write_term(1.01,[float_format('~3f')]).
299 % 1.010
300
301
302 % -------------------
303
304
305 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:to_b_string(int(10),string('10')))).
306 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:to_b_string(pred_true,string('TRUE')))).
307 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:to_b_string([],string('{}')))).
308 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:to_b_string(string('01'),string('01')))).
309 :- assert_must_succeed(exhaustive_kernel_fail_check(kernel_strings:to_b_string(int(1),string('01')))).
310
311 :- block to_b_string(-,?).
312 to_b_string(int(I),S) :- !,
313 int_to_string2(I,S).
314 to_b_string(string(S),Res) :- !,
315 Res=string(S). % we already have a string; nothing needs to be done
316 to_b_string(Value,S) :- ground_value_check(Value,GrValue),
317 to_string_aux(GrValue,Value,[],S).
318
319 % version with options
320 :- block to_b_string_with_options(-,?,?).
321 to_b_string_with_options(int(I),_,S) :- !,
322 int_to_string2(I,S).
323 to_b_string_with_options(string(S),_,Res) :- !,
324 Res=string(S). % we already have a string; nothing needs to be done
325 to_b_string_with_options(Value,Options,S) :- ground_value_check(Value,GrValue),
326 to_string_aux(GrValue,Value,Options,S).
327
328 :- block to_string_aux(-,?,?,?).
329 to_string_aux(_,Value,Options,Str) :- to_string_aux(Value,Options,Str).
330
331 :- use_module(preferences,[temporary_set_preference/3,reset_temporary_preference/2]).
332 :- use_module(translate,[translate_bvalue/2, set_unicode_mode/0, unset_unicode_mode/0]).
333 % convert_to_avl
334 to_string_aux(Value,Options,Str) :-
335 normalise_value_for_to_string(Value,NValue),
336 temporary_set_preference(expand_avl_upto,100000,CHNG),
337 (member(unicode,Options) -> set_unicode_mode ; true),
338 translate_bvalue(NValue,Atom),
339 reset_temporary_preference(expand_avl_upto,CHNG),
340 !,
341 (member(unicode,Options) -> unset_unicode_mode ; true), % TO DO: use call_cleanup
342 Str=string(Atom).
343 to_string_aux(Value,_,Str) :-
344 add_internal_error('Translation to string failed: ',Value),
345 Str=string('???').
346
347
348 :- use_module(store,[normalise_value_for_var/3]).
349 % normalise_value_for_var normalises values for storing; for printing we need to do less work
350 % e.g., we do not need to normalise AVL values; we could add further cases for records ...
351 normalise_value_for_to_string(avl_set(A),R) :- !, R=avl_set(A).
352 normalise_value_for_to_string((A,B),R) :- !, R=(NA,NB),
353 normalise_value_for_to_string(A,NA),
354 normalise_value_for_to_string(B,NB).
355 normalise_value_for_to_string(A,R) :- normalise_value_for_var(to_b_string,A,R).
356
357
358
359 % -------------------
360
361 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_append_wf(string('a'),string('b'),string('ab'),WF),WF)).
362 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_append_wf(string('0'),string('1'),string('01'),WF),WF)).
363 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_append_wf(string('aa'),string(''),string('aa'),WF),WF)).
364 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_append_wf(string(''),string('aa'),string('aa'),WF),WF)).
365 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(kernel_strings:b_string_append_wf(string('0'),string('1'),string('1'),WF),WF)).
366
367 :- block b_string_append_wf(-,?,-,?), b_string_append_wf(?,-,-,?).
368 b_string_append_wf(string(A),string(B),string(C),WF) :-
369 ? app2(A,B,C,WF).
370 :- block app2(-,?,-,?), app2(?,-,-,?).
371 app2(A,B,C,_WF) :-
372 nonvar(A),nonvar(B),!,atom_concat(A,B,CC), /* overcome bug in SICStus; delay unification */
373 CC=C.
374 ?app2(A,B,C,WF) :- atom_codes(C,CC), app3(A,B,CC,WF).
375
376 :- use_module(kernel_waitflags,[get_wait_flag/4]).
377 % append in reverse mode: result is known
378 app3(A,B,[],_) :- !, A='', B=''.
379 app3(A,B,CC,WF) :-
380 ( nonvar(B) -> atom_codes(B,BB), append(AA,BB,CC), atom_codes(A,AA)
381 ; nonvar(A) -> atom_codes(A,AA), append(AA,BB,CC), atom_codes(B,BB)
382 ; length(CC,CLen), % there are CLen + 1 ways to split the string;
383 % but if we have multiple string appends a ^ b ^ c = "abc" -> 10 ways to split rather than 4
384 Prio is CLen+1,
385 get_wait_flag(Prio,'STRING_APPEND',WF,LWF),
386 app4(A,B,CC,WF,LWF)
387 ).
388 % block used to be wrong: :- block app4(-,?,-,?,-), app4(?,-,-,?,-).
389 % was enumerating in phase 0: >>> "10ACAUE1700R" = ((p ^ i) ^ e) ^ t & p^e^t = "abc"
390 % Note: CC is always known, proceed when either A or B are known or wait flag set
391 :- block app4(-,-,?,?,-).
392 app4(A,B,CC,WF,_) :-
393 (nonvar(A) ; nonvar(B)), !, % no need to enumerate
394 ? app3(A,B,CC,WF).
395 app4(A,B,CC,_WF,_) :- %print(enumerating(CC)),nl,
396 append(AA,BB,CC), % will be non-deterministic
397 atom_codes(A,AA), atom_codes(B,BB).
398
399 % -------------------------------------------------
400 % the conc(.) operator is mapped to this for strings (instead to concat_sequence)
401
402 b_concat_sequence_of_strings_wf(List,Res,Span,WF) :-
403 convert_seq_to_sorted_list(List,SortedList,Done),
404 string_conc_aux(Done,SortedList,1,Res,Span,WF).
405
406 :- block string_conc_aux(-,?,?,?,?,?).
407 string_conc_aux(_,List,Idx1,TRes,Span,WF) :-
408 string_conc_aux2(List,Idx1,TRes,Span,WF).
409
410 :- use_module(kernel_waitflags,[add_wd_error_span/4]).
411 string_conc_aux2([],_,string(''),_,_WF).
412 string_conc_aux2([(int(IdxH),H)|T],Idx,Res,Span,WF) :-
413 (T==[] -> Res=H % values are strings; no need to call equal_object
414 ; IdxH=Idx ->
415 Idx1 is Idx+1,
416 string_conc_aux2(T,Idx1,TRes,Span,WF),
417 b_string_append_wf(H,TRes,Res,WF)
418 ; add_wd_error_span('Illegal index in sequence of strings for concatenation:',IdxH,Span,WF)
419 ).
420
421 % ensure indexes of B sequence are sorted correctly (TO DO: no need to call when we have constructed list from avl_set)
422 convert_seq_to_sorted_list(List,SortedList,Done) :-
423 custom_explicit_sets:expand_custom_set_to_list(List,ESet,_,string_conc),
424 convert_list_to_sorted_list(ESet,[],SortedList,Done).
425
426 :- block convert_list_to_sorted_list(-,?,?,?).
427 convert_list_to_sorted_list([],Acc,Res,Done) :- sort(Acc,Res), Done=true.
428 convert_list_to_sorted_list([(int(Idx),El)|T],Acc,Res,Done) :-
429 convert_list_to_sorted_list2(Idx,T,[(int(Idx),El)|Acc],Res,Done).
430
431 :- block convert_list_to_sorted_list2(-,?,?,?,?).
432 convert_list_to_sorted_list2(_,List,Acc,Res,Done) :- convert_list_to_sorted_list(List,Acc,Res,Done).
433
434
435 % -------------------------------------------------
436
437 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_reverse_wf(string('01001'),string('10010'),no_wf_available))).
438
439 :- block b_string_reverse_wf(-,-,?).
440 b_string_reverse_wf(string(A),string(B),_) :-
441 string_reverse2(A,B).
442
443 :- block string_reverse2(-,-).
444 string_reverse2(A,B) :- nonvar(A),!, atom_codes(A,AA), reverse(AA,RA), atom_codes(B,RA).
445 string_reverse2(B,A) :- atom_codes(A,AA), reverse(AA,RA), atom_codes(B,RA).
446
447 % -------------------------------------------------
448
449 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_split_wf(string('01001'),string('1'),[(int(1),string('0')),(int(2),string('00')),(int(3),string(''))],no_wf_available))).
450 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_split_wf(string('789'),string('1'),[(int(1),string('789'))],no_wf_available))).
451 :- assert_must_succeed(exhaustive_kernel_fail_check(kernel_strings:b_string_split_wf(string('aaa'),string('a'),[(int(1),string('a')),(int(2),string('a'))],no_wf_available))).
452
453 % function to split a string into a list of strings which were delimited by a separator
454 % WARNING: if the seperator is of length more than one, then first match-strategy will be used
455 :- block b_string_split_wf(?,-,?,?), b_string_split_wf(-,?,-,?).
456 b_string_split_wf(string(A),string(B),R,WF) :-
457 string_split2(A,B,R,WF).
458 :- block string_split2(?,-,?,?),string_split2(-,?,-,?).
459 string_split2(Atom,Seperator,SplitAtomList,WF) :-
460 (var(Atom) ; var(Seperator)),
461 !, % currently : separator always known
462 expand_custom_set_to_ground_list_wf(SplitAtomList,ExpandedSplitAtomList,Done,string_split2,WF),
463 string_split3(Atom,Seperator,SplitAtomList,Done,ExpandedSplitAtomList,WF).
464 string_split2(Atom,Separator,SplitAtomList,WF) :- % normal forward mode: atom and separator known:
465 string_split_forward(Atom,Separator,SplitAtomList,WF).
466
467 string_split_forward(Atom,Separator,SplitAtomList,WF) :-
468 split_atom_string(Atom,Separator,List), % safe_call ?
469 convert_prolog_to_b_list(List,SplitAtomList,WF).
470
471 :- block string_split3(?,-,?,?,?,?),string_split3(-,?,?,-,?,?). % we need to know the seperator: TO DO : improve this
472 string_split3(Atom,Seperator,SplitAtomList,Done,_ExpandedSplitAtomList,WF) :-
473 var(Done),
474 !,
475 string_split_forward(Atom,Seperator,SplitAtomList,WF).
476 string_split3(Atom,Seperator,SplitAtomList,_Done,ExpandedSplitAtomList,WF) :-
477 ExpandedSplitAtomList \= [], % split("",sep) --> [""] not the empty list; note: this is not a WD error, the constraint STRING_SPLIT(a,b) = [] is simply unsatisfiable
478 !,
479 sort(ExpandedSplitAtomList,SL),
480 maplist(drop_index,SL,IL), % also: no WD error needs to be raised if this is not a sequence
481 convert_b_to_prolog_atoms(IL,PL,Done),
482 atom_codes(Seperator,SepCodes),
483 append(SepCodes,_,SepCodes2),
484 split4(Done,SepCodes2,PL,Seperator,Atom,SplitAtomList,WF).
485
486
487 :- use_module(probsrc(tools_strings),[ajoin/2]).
488
489 :- block split4(-,?,?,?,-,?,?), split4(-,?,?,-,?,?,?).
490 % unblock either when Done or when both Atom and Sperator known
491 split4(Done,_SepCodes2,_PL,Seperator,Atom,SplitAtomList,WF) :-
492 var(Done),
493 !,
494 % we can now compute forwards anyhow; ignore backwards direction
495 string_split_forward(Atom,Seperator,SplitAtomList,WF).
496 split4(_,SepCodes2,PL,Seperator,Atom,_,_) :-
497 maplist(not_suffix_atom(SepCodes2),PL), % check that seperator occurs in no split atom: e.g. STRING_SPLIT(r,"_") = ["a","_","c"] should fail
498 insert_sep(PL,Seperator,PL2),
499 ajoin(PL2,Atom).
500
501 insert_sep([],_,[]).
502 insert_sep([H],_,R) :- !, R=[H].
503 insert_sep([H|T],Sep,[H,Sep|IT]) :- insert_sep(T,Sep,IT).
504
505 ?not_suffix_atom(SepCodes,Atom) :- \+ suffix_atom(SepCodes,Atom).
506 suffix_atom(SepCodes,Atom) :-
507 atom_codes(Atom,AL),
508 append(_,SepCodes,AL).
509
510 expand_custom_set_to_ground_list_wf(Set,ExpandedList,DoneGround,PP,WF) :-
511 expand_custom_set_to_list_wf(Set,ExpandedList,_Done,PP,WF),
512 % _Done nonvar is not sufficient for sorting the list; indices might be unbound
513 ground_value_check(ExpandedList,DoneGround).
514
515 % ------------------------
516
517 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_join_wf([(int(1),string('0')),(int(2),string('00')),(int(3),string(''))],string('1'),string('01001'),unknown,WF),WF)).
518 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_join_wf([(int(1),string('0')),(int(2),string('00'))],string('1'),string('0100'),unknown,WF),WF)).
519 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_join_wf([(int(1),string('0'))],string('1'),string('0'),unknown,WF),WF)).
520 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_join_wf([],string('-'),string(''),unknown,WF),WF)).
521 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_string_join_wf([(int(1),string('a')),(int(2),string('bb')),(int(3),string('ccc')),(int(4),string('dddd'))],string('*'),string('a*bb*ccc*dddd'),unknown,WF),WF)).
522
523 :- block b_string_join_wf(?,-,?,?,?), b_string_join_wf(-,?,?,?,?).
524 b_string_join_wf(SplitAtoms,string(Sep),Res,Span,WF) :- string_join2(SplitAtoms,Sep,Res,Span,WF).
525
526 % this is not reversible ["a","b"],"_" -> "a_b" but ["a_b"],"_" -> "a_b" has same result
527 :- block string_join2(?,-,?,?,?),string_join2(-,?,?,?,?).
528 string_join2(SplitAtomList,Seperator,Result,Span,WF) :-
529 expand_custom_set_to_ground_list_wf(SplitAtomList,ExpandedSplitAtomList,GrDone,string_join2,WF),
530 % indices have to be ground for sorting, and strings for joining
531 string_join3(Result,Seperator,SplitAtomList,GrDone,ExpandedSplitAtomList,Span,WF).
532
533 :- use_module(kernel_objects,[equal_object/3, equal_object_optimized_wf/4, equal_object_wf/4]).
534 :- block string_join3(?,-,?,?,?,?,?),string_join3(?,?,?,-,?,?,?). % we need to know the seperator: TO DO : improve this
535 string_join3(Result,Seperator,_SplitAtomList,_Done,ExpandedSplitAtomList,Span,WF) :-
536 %ExpandedSplitAtomList \= [], !, % commented out this means that STRING_JOIN([],sep) = ""
537 % result of split("",sep) --> [""] : this is not the empty list; i.e., STRING_JOIN is then no longer injective
538 sort(ExpandedSplitAtomList,SL),
539 drop_index_with_seq_check(SL,1,IL,Span,WF),
540 convert_b_to_prolog_atoms(IL,PL,Done2),
541 finish_join(Done2,PL,Seperator,Result,WF).
542 %string_join3(Result,_Seperator,SplitAtomList,_Done,[],Span,WF) :-
543 % add_wd_error_set_result('### STRING_JOIN not defined for empty sequence: ',SplitAtomList,Result,string(''),Span,WF).
544
545 %:- block drop_index_with_seq_check(-,?,?,?,?).
546 drop_index_with_seq_check([],_,[],_,_).
547 drop_index_with_seq_check([(int(Nr),R)|T],Expected,[R|TR],Span,WF) :-
548 (Nr=Expected -> E1 is Expected+1, drop_index_with_seq_check(T,E1,TR,Span,WF)
549 ; ajoin(['Unexpected index: ',Nr,'! Argument for STRING_JOIN is not a sequence! Expected next index to be: '],Msg),
550 add_wd_error_set_result(Msg,Expected,TR,[],Span,WF)
551 ).
552
553 :- block finish_join(-,?,?,?,?).
554 finish_join(_Done,PL,Seperator,Result,WF) :-
555 insert_sep(PL,Seperator,PL2),
556 ajoin(PL2,Atom),
557 equal_object_optimized_wf(Result,string(Atom),string_join,WF).
558
559 % -----------------------
560
561 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_chars(string(''),[]))).
562 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_chars(string('010'),[(int(1),string('0')),(int(2),string('1')),(int(3),string('0'))]))).
563 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_chars(string('a'),[(int(1),string('a'))]))).
564
565 :- block b_string_chars(-,-).
566 b_string_chars(Str,SeqRes) :- nonvar(Str), Str=string(A), ground(A),!,
567 string_chars2(A,SeqRes).
568 b_string_chars(Str,SeqRes) :- when((ground(Str);ground(SeqRes)),string_chars1(Str,SeqRes)).
569
570 string_chars1(Str,SeqRes) :- nonvar(Str), Str=string(A), ground(A),!,
571 % construct sequence from string:
572 string_chars2(A,SeqRes).
573 string_chars1(Str,SeqRes) :-
574 expand_custom_set_to_list(SeqRes,ExpandedAtomList,Done,string_chars1),
575 string_chars3(Str,SeqRes,ExpandedAtomList,Done).
576
577 :- use_module(kernel_objects,[equal_object_optimized/3]).
578 string_chars2(A,SeqRes) :- atom_codes(A,AA), generate_char_seq(AA,1,CharSeq),
579 equal_object_optimized(CharSeq,SeqRes,string_chars2).
580
581
582 :- block string_chars3(-,?,?,-).
583 string_chars3(Str,SeqRes,_ExpandedAtomList,_Done) :-
584 % construct sequence from string:
585 nonvar(Str), Str=string(A), ground(A),
586 !,
587 string_chars2(A,SeqRes).
588 string_chars3(Str,_SeqRes,ExpandedAtomList,Done) :-
589 nonvar(Done),
590 % construct string from sequence:
591 !,
592 sort(ExpandedAtomList,SL),
593 maplist(drop_index,SL,IL),
594 convert_b_to_prolog_atoms(IL,PL,Done2),
595 when(nonvar(Done2),
596 (ajoin(PL,Atom),
597 equal_object(Str,string(Atom),b_string_chars))).
598 string_chars3(Str,SeqRes,ExpandedAtomList,Done) :- % Str is only partially instantiated
599 when((ground(Str);nonvar(Done)),string_chars3(Str,SeqRes,ExpandedAtomList,Done)).
600 generate_char_seq([],_,[]).
601 generate_char_seq([Code|T],Nr,[(int(Nr),string(CS))|TSeq]) :-
602 atom_codes(CS,[Code]),
603 N1 is Nr+1, generate_char_seq(T,N1,TSeq).
604
605 drop_index((int(_),R),R).
606
607
608 % ------------------------
609
610 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_codes(string(''),[]))).
611 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_codes(string('010'),[(int(1),int(48)),(int(2),int(49)),(int(3),int(48))]))).
612
613 :- block b_string_codes(-,-).
614 b_string_codes(string(A),SeqRes) :- string_codes2(A,SeqRes).
615
616
617 :- block string_codes2(-,-).
618 string_codes2(A,SeqRes) :-
619 nonvar(A),
620 !,
621 string_codes4(A,SeqRes).
622 string_codes2(A,SeqRes) :-
623 SeqRes==[],
624 !,
625 empty_b_string_atom(A).
626 string_codes2(A,SeqRes) :- expand_custom_set_to_list(SeqRes,SeqList,_,string_codes2),
627 when((nonvar(A);ground(SeqList)), string_codes3(A,SeqList)).
628
629 string_codes3(A,SeqRes) :-
630 nonvar(A),
631 !,
632 string_codes4(A,SeqRes).
633 string_codes3(A,SeqRes) :-
634 sort(SeqRes,SSeqRes),
635 extract_codes(SSeqRes,1,Codes),
636 atom_codes(A,Codes).
637 string_codes4(A,SeqRes) :-
638 atom_codes(A,AA), generate_code_sequence(AA,1,CodeSeq),
639 equal_object_optimized(CodeSeq,SeqRes,string_codes4).
640
641 generate_code_sequence([],_,[]).
642 generate_code_sequence([Code|T],Nr,[(int(Nr),int(Code))|TSeq]) :-
643 N1 is Nr+1, generate_code_sequence(T,N1,TSeq).
644
645 extract_codes([],_,[]).
646 extract_codes([(int(Nr),int(Code))|T],N,[Code|CT]) :-
647 (Nr==N -> true ; add_error(extract_codes,'Unexpected index: ',(Nr,N))),
648 N1 is N+1, extract_codes(T,N1,CT).
649
650
651 empty_b_string_atom('').
652
653 % ------------------------
654
655 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_equal_case_insensitive(string(abCdAZ),string('ABcDAZ'),pred_true))).
656 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_equal_case_insensitive(string(a),string(aa),pred_false))).
657
658 % does not seem to be really faster than doing twice b_string_to_uppercase and comparing the result
659 % in principle we avoid building up two atoms for the upper case string
660 :- block b_string_equal_case_insensitive(-,?,?), b_string_equal_case_insensitive(?,-,?).
661 b_string_equal_case_insensitive(string(A),string(B),Res) :-
662 str_eq_nocase(A,B,Res).
663
664 :- block str_eq_nocase(-,?,?), str_eq_nocase(?,-,?).
665 str_eq_nocase(A,A,Res) :- !, Res=pred_true.
666 %str_eq_nocase(A,B,Res) :- % performance not improved by this rule
667 % atom_length(A,L1), atom_length(B,L2), L1\=L2,
668 % !, % in case upcase replaces one char by two we need to adapt this rule;
669 % % check that atom_length deals with unicode chars correctly
670 % Res=pred_false.
671 str_eq_nocase(A,B,Res) :-
672 atom_codes(A,CA),
673 atom_codes(B,CB),
674 (l_eq_upcase(CA,CB) -> Res=pred_true ; Res=pred_false).
675
676 l_eq_upcase([],[]).
677 l_eq_upcase([H1|T1],[H2|T2]) :-
678 (H1=H2 -> true ; upcase(H1,HU), upcase(H2,HU)),
679 l_eq_upcase(T1,T2).
680
681
682 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_to_uppercase(string(abcdAZ),string('ABCDAZ')))).
683
684 :- block b_string_to_uppercase(-,?).
685 b_string_to_uppercase(string(A),Res) :- string_to_uppercase2(A,Res).
686 % TO DO: add flag to make unicode/umlaut conversions optional
687
688 :- block string_to_uppercase2(-,?).
689 string_to_uppercase2(A,Res) :- atom_codes(A,AA),
690 l_upcase(AA,UpCodes),
691 atom_codes(AU,UpCodes),
692 Res = string(AU).
693
694 l_upcase([],[]).
695 l_upcase([H|T],[HU|TU]) :- upcase(H,HU), l_upcase(T,TU).
696
697 upcase(223,R) :- !, R is "S". % ß
698 upcase(199,R) :- !, R is "C". % upper case ç
699 upcase(231,R) :- !, R is "C". % ç
700 upcase(208,R) :- !, R is "D". % special D
701 upcase(209,R) :- !, R is "N". % Ñ
702 upcase(241,R) :- !, R is "N". % ñ
703 upcase(221,R) :- !, R is "Y". % upper case ý
704 upcase(253,R) :- !, R is "Y". % ý
705 upcase(255,R) :- !, R is "Y". % ÿ
706
707 upcase(H,R) :- H<"a", !,R=H. % Z code is 90, a code is 97
708 upcase(H,R) :- H >="a", H=<"z", !, R is H+"A"-"a".
709 upcase(H,R) :- H >=192, H=<197, !, R is "A". % upper-case A
710 upcase(H,R) :- H >=224, H=<229, !, R is "A". % H >="à", H=<"å"
711 upcase(H,R) :- H >=200, H=<203, !, R is "E". % upper-case E
712 upcase(H,R) :- H >=232, H=<235, !, R is "E". % H >="è", H=<"ë"
713 upcase(H,R) :- H >=204, H=<207, !, R is "I". % upper-case I
714 upcase(H,R) :- H >=236, H=<239, !, R is "I". % H >="ì", H=<"ï"
715 upcase(H,R) :- H >=210, H=<214, !, R is "O". % upper-case O
716 upcase(H,R) :- H >=242, H=<246, !, R is "O". % H >="ò", H=<"ö"
717 upcase(H,R) :- H >=217, H=<220, !, R is "U". % upper-case U
718 upcase(H,R) :- H >=249, H=<252, !, R is "U". % H >="ù", H=<"ü"
719 upcase(H,R) :- H =< 255,!, R=H.
720 % some special variations of characters; there are a few chars in between which represent multiple chars ae,...
721 upcase(H,R) :- H >=256, H=<261, !, R is "A".
722 upcase(H,R) :- H >=262, H=<269, !, R is "C".
723 upcase(H,R) :- H >=270, H=<273, !, R is "D".
724 upcase(H,R) :- H >=274, H=<283, !, R is "E".
725 upcase(H,R) :- H >=284, H=<291, !, R is "G".
726 upcase(H,R) :- H >=292, H=<295, !, R is "H".
727 upcase(H,R) :- H >=296, H=<305, !, R is "I".
728 upcase(H,R) :- H >=308, H=<309, !, R is "J".
729 upcase(H,R) :- H >=310, H=<312, !, R is "K".
730 upcase(H,R) :- H >=313, H=<322, !, R is "L".
731 upcase(H,R) :- H >=323, H=<331, !, R is "N".
732 upcase(H,R) :- H >=332, H=<337, !, R is "O".
733 upcase(H,R) :- H >=340, H=<345, !, R is "R".
734 upcase(H,R) :- H >=346, H=<353, !, R is "S".
735 upcase(H,R) :- H >=354, H=<359, !, R is "T".
736 upcase(H,R) :- H >=360, H=<371, !, R is "U".
737 upcase(H,R) :- H >=372, H=<373, !, R is "W".
738 upcase(H,R) :- H >=374, H=<376, !, R is "Y".
739 upcase(H,R) :- H >=377, H=<382, !, R is "Z".
740 upcase(H,R) :- H >=384, H=<389, !, R is "B".
741 upcase(Code,Code).
742
743 % between:between(190,300,Char), format(' ~w = ~s~n',[Char,[Char]]),fail.
744 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_to_lowercase(string('ABCD-az'),string('abcd-az')))).
745
746 :- block b_string_to_lowercase(-,?).
747 b_string_to_lowercase(string(A),Res) :- string_to_lowercase2(A,Res).
748 % TO DO: add flag to make unicode/umlaut conversions optional
749
750 :- block string_to_lowercase2(-,?).
751 string_to_lowercase2(A,Res) :- atom_codes(A,AA),
752 l_upcase(AA,UpCodes),
753 l_lowcase(UpCodes,LowCodes),
754 atom_codes(AU,LowCodes),
755 Res = string(AU).
756
757 l_lowcase([],[]).
758 l_lowcase([H|T],[HU|TU]) :- simple_lowcase(H,HU), l_lowcase(T,TU).
759
760 simple_lowcase(H,R) :- 0'A =< H, H =< 0'Z, !, R is H+0'a-0'A.
761 simple_lowcase(Code,Code).
762
763
764
765 % ------------------------
766
767 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_substring_wf(string(abcd),int(1),int(2),string(ab),unknown,WF),WF)).
768 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_substring_wf(string(abcd),int(1),int(6),string(abcd),unknown,WF),WF)).
769 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_substring_wf(string(abcd),int(4),int(6),string(d),unknown,WF),WF)).
770 :- assert_must_succeed(exhaustive_kernel_check_wf(kernel_strings:b_substring_wf(string(abcd),int(4),int(0),string(''),unknown,WF),WF)).
771
772
773 :- block b_substring_wf(-,?,?,?,?,?),b_substring_wf(?,-,?,?,?,?),b_substring_wf(?,?,-,?,?,?).
774 b_substring_wf(string(S),int(From),int(Len),Res,Span,WF) :-
775 substring(S,From,Len,Res,Span,WF).
776
777 :- block substring(-,?,?,?,?,?),substring(?,-,?,?,?,?),substring(?,?,-,?,?,?).
778 substring(_,From,_Len,Res,Span,WF) :- From<1,!,
779 add_wd_error_set_result('From index for SUB_STRING must be positive: ',From,Res,string(''),Span,WF).
780 substring(S,From,Len,Res,_Span,_WF) :-
781 PrefixLen is From-1, Length=Len,
782 (Length < 1 -> empty_b_string_atom(ResAtom)
783 ; atom_codes(S,Codes),
784 (sublist(Codes, SelectedCodes, PrefixLen , Length, _)
785 -> true
786 ? ; sublist(Codes, SelectedCodes, PrefixLen , RealLength, 0),
787 RealLength < Length
788 -> true
789 ; empty_b_string_atom(ResAtom) % Deal with case that PrefixLen beyond length of string
790 ),
791 atom_codes(ResAtom,SelectedCodes)
792 ),
793 Res = string(ResAtom).
794
795
796 % ------------------------
797
798 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_replace(string(abcdAZ),string('cd'),string('_'),string(ab_AZ)))).
799
800 :- block b_string_replace(-,?,?,?),b_string_replace(?,-,?,?),b_string_replace(?,?,-,?).
801 b_string_replace(string(S),string(Pat),string(New),Res) :-
802 string_replace_aux(S,Pat,New,Res).
803
804 :- block string_replace_aux(-,?,?,?),string_replace_aux(?,-,?,?),string_replace_aux(?,?,-,?).
805 string_replace_aux(S,Pat,New,Res) :-
806 atom_codes(S,SC), atom_codes(Pat,PC), atom_codes(New,NC),
807 replace_pat(PC,NC,RC,SC,[]),
808 atom_codes(R,RC),
809 Res = string(R).
810
811 :- assert_must_succeed((kernel_strings: replace_pat("%0","_1_",Res,"ab%0cd",[]), Res == "ab_1_cd")).
812 :- assert_must_succeed((kernel_strings: replace_pat("%0","",Res,"ab%0%0cd%0",[]), Res == "abcd")).
813 % dcg utility to replace %Pat by NewStr constructing Res; see also visb_visualiser
814 replace_pat(Pat,NewStr,Res) --> Pat, !, {append(NewStr,TR,Res)}, replace_pat(Pat,NewStr,TR).
815 replace_pat(Pat,RepStr,[H|T]) --> [H],!, replace_pat(Pat,RepStr,T).
816 replace_pat(_,_,[]) --> [].
817
818
819 % ------------------------
820
821 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:format_to_b_string(string('abc'),[],string('abc')))).
822 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:format_to_b_string(string('abc~wfg'),[(int(1),string('de'))],string('abcdefg')))).
823 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:format_to_b_string(string('abc~wfg~w'),[(int(1),string('de')),(int(2),string('h'))],string('abcdefgh')))).
824
825 :- block format_to_b_string(-,?,?).
826 format_to_b_string(string(FormatString),BSeqOfValues,Res) :-
827 convert_b_sequence_to_list_of_atoms(BSeqOfValues,ListOfAtoms,Done),
828 format_to_string_aux(Done,FormatString,ListOfAtoms,Res).
829
830 :- use_module(library(codesio),[format_to_codes/3]).
831 :- block format_to_string_aux(-,?,?,?), format_to_string_aux(?,-,?,?).
832 format_to_string_aux(_,FormatString,ListOfAtoms,Res) :-
833 format_to_codes(FormatString,ListOfAtoms,Codes),
834 atom_codes(Atom,Codes),
835 Res = string(Atom).
836
837
838 % convert a B sequence into a list of atoms; pretty printing if necessary
839 :- block convert_b_sequence_to_list_of_atoms(-,?,?).
840 convert_b_sequence_to_list_of_atoms(BSeqOfValues,Res,Done) :-
841 is_set_value(BSeqOfValues,convert_b_sequence_to_list_of_atoms),
842 !,
843 expand_custom_set_to_list_gg(BSeqOfValues,ESet,GG,kernel_strings), % GG=guaranteed_ground or not_guaranteed_ground
844 (GG=guaranteed_ground -> GrESet=true ; ground_value_check(ESet,GrESet)),
845 convert_aux(GrESet,ESet,Res,Done).
846 convert_b_sequence_to_list_of_atoms(SingleValue,[S],Done) :-
847 translate_bvalue(SingleValue,XS),
848 add_warning(kernel_strings,'B sequence expected, obtained single value: ',XS),
849 ground_value_check(SingleValue,GrValue),
850 to_string_aux(GrValue,SingleValue,[],string(S)),
851 Done=GrValue.
852
853 :- block convert_aux(-,?,?,?), convert_aux(?,-,?,?).
854 convert_aux(_,ESet,ListOfAtoms,Done) :-
855 sort(ESet,SortedESet),
856 maplist(get_string,SortedESet,ListOfAtoms),
857 Done=true.
858
859 get_string((_,string(S)),R) :- !,R=S.
860 get_string((_,X),R) :- !,to_string_aux(X,[],string(R)).
861 get_string(X,R) :-
862 translate_bvalue(X,XS),
863 add_warning(kernel_strings,'B sequence expected, obtained set containing: ',XS),
864 to_string_aux(X,[],string(R)).
865
866
867 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_alphanumerical(string('a10'),pred_true))).
868 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_alphanumerical(string(''),pred_false))).
869 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_alphanumerical(string('1.0'),pred_false))).
870 :- assert_must_succeed(exhaustive_kernel_succeed_check(kernel_strings:b_string_is_alphanumerical(string('a_z'),pred_false))).
871
872 :- block b_string_is_alphanumerical(-,?).
873 b_string_is_alphanumerical(string(S),Res) :-
874 string_is_alpha_aux(S,Res).
875 :- block string_is_alpha_aux(-,?).
876 string_is_alpha_aux(S,Res) :-
877 atom_codes(S,Codes),
878 (Codes \= [],
879 ? is_alphnum_aux(Codes)
880 -> Res=pred_true
881 ; Res=pred_false).
882
883 is_alphnum_aux([]).
884 ?is_alphnum_aux([H|T]) :- is_alpha_numerical(H),is_alphnum_aux(T).
885
886 % see also is_alphabetical_ascii_code, is_digit_code in tools_strings
887 is_alpha_numerical(Code) :- Code >= 48, Code =< 57. % 0-9
888 is_alpha_numerical(Code) :- Code >= 65, Code =< 90. % A-Z
889 is_alpha_numerical(Code) :- Code >= 97, Code =< 122. % a-z
890
891 % ------------------------
892 % UTILITIES
893 % ------------------------
894
895
896 :- assert_must_succeed((kernel_strings:split_atom_string('ef,g',',',R), R==[ef,g])).
897 :- assert_must_succeed((kernel_strings:split_atom_string('ab,cd,ef,g',',',R), R==['ab','cd',ef,g])).
898 :- assert_must_succeed((kernel_strings:split_atom_string('ab','a',R), R==['','b'])).
899 :- assert_must_succeed((kernel_strings:split_atom_string('','a',R), R==[''])).
900 :- assert_must_succeed((kernel_strings:split_atom_string('STRING1','',R), R==['STRING1'])).
901 :- assert_must_succeed((kernel_strings:split_atom_string('mod274,mod276,mod277,mod282,mod283,mod284,mod285,mod286',',',R), R==[mod274,mod276,mod277,mod282,mod283,mod284,mod285,mod286])).
902
903 split_atom_string(Atom,Sep,SplitList) :-
904 atom_chars(Sep,SepAscii),
905 (SepAscii=[] -> SplitList = [Atom]
906 ; SepAscii = [H|T], atom_chars(Atom,ListAscii),
907 split3(ListAscii,H,T,Match,Match,SplitList)).
908
909 % MatchSoFar is passed in two variables: one to instantiate and one with the Result of the match
910 % this avoids calling reverse
911 split3([],_,_,MatchSoFarIn,MatchSoFarRes,R) :- !,
912 MatchSoFarIn=[], % match complete, ground tail of match
913 atom_chars(Atom,MatchSoFarRes),R=[Atom].
914 split3([H|List],H,Sep,MatchSoFarIn,MatchSoFarRes,Res) :-
915 append(Sep,Tail,List),
916 !, % we have a match with a separator
917 MatchSoFarIn=[], % match complete
918 atom_chars(Atom,MatchSoFarRes),
919 Res=[Atom|R2], split3(Tail,H,Sep,NewMatch,NewMatch,R2).
920 split3([H|T],HS,Sep,[H|MatchSoFarIn],MatchSoFarRes,Res) :- % no match
921 split3(T,HS,Sep,MatchSoFarIn,MatchSoFarRes,Res).
922
923
924
925 % -----------------------
926
927 convert_prolog_to_b_list(PL,BL,WF) :-
928 convert_prolog_to_b_list_aux(PL,1,CPL),
929 try_expand_and_convert_to_avl(CPL,CPL2),
930 equal_object_wf(CPL2,BL,convert_prolog_to_b_list,WF).
931
932
933 convert_prolog_to_b_list_aux([],_,[]).
934 convert_prolog_to_b_list_aux([H|T],Index,[(int(Index),CH)|CT]) :-
935 convert_prolog_to_b_term(H,CH),
936 I1 is Index+1, convert_prolog_to_b_list_aux(T,I1,CT).
937
938 convert_prolog_to_b_term(N,R) :-
939 number(N),!,
940 R=int(N).
941 convert_prolog_to_b_term(A,R) :-
942 atomic(A),!,
943 R=string(A).
944 convert_prolog_to_b_term(A,R) :-
945 add_internal_error('Illegal Prolog term: ',convert_prolog_to_b_term(A,R)), R=A.
946
947
948 % a version that delays converting and sets Done to done when all B Atoms have been grounded
949 :- block convert_b_to_prolog_atoms(-,?,?).
950 convert_b_to_prolog_atoms([],[],done).
951 convert_b_to_prolog_atoms([BAtom|T],[PrologAtom|PT],Done) :-
952 convert_b_to_prolog_atoms_aux(BAtom,PrologAtom,DoneAtom),
953 convert_b_to_prolog_atoms(T,PT,DoneT),
954 both_done(DoneAtom,DoneT,Done).
955
956 :- block both_done(-,?,?), both_done(?,-,?).
957 both_done(_,_,done).
958
959 :- block convert_b_to_prolog_atoms_aux(-,?,?).
960 convert_b_to_prolog_atoms_aux(pred_true,'TRUE',done).
961 convert_b_to_prolog_atoms_aux(pred_false,'FALSE',done).
962 convert_b_to_prolog_atoms_aux(string(S),PrologAtom,Done) :-
963 convert_b_to_prolog_atoms_aux2(S,PrologAtom,Done).
964 convert_b_to_prolog_atoms_aux(int(S),PrologAtom,Done) :-
965 convert_b_to_prolog_atoms_aux2(S,PrologAtom,Done).
966
967 :- block convert_b_to_prolog_atoms_aux2(-,?,?).
968 convert_b_to_prolog_atoms_aux2(Atom,Atom,done).