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