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