kernel_strings

app2(A,B,C,_WF) :-
    nonvar(A),nonvar(B),!,atom_concat(A,B,CC), /* overcome bug in SICStus; delay unification */
    CC=C.

app2(A,B,C,WF) :- atom_codes(C,CC), app3(A,B,CC,WF).

app3(A,B,[],_) :- !, A='', B=''.

app3(A,B,CC,WF) :-
    ( nonvar(B) -> atom_codes(B,BB), append(AA,BB,CC), atom_codes(A,AA)
    ; nonvar(A) -> atom_codes(A,AA), append(AA,BB,CC), atom_codes(B,BB)
    ; length(CC,CLen), % there are CLen + 1 ways to split the string;
    % but if we have multiple string appends a ^ b ^ c = "abc" -> 10 ways to split rather than 4
    Prio is CLen+1,
    get_wait_flag(Prio,'STRING_APPEND',WF,LWF),
    app4(A,B,CC,WF,LWF)
).

app4(A,B,CC,WF,_) :-
    (nonvar(A) ; nonvar(B)), !, % no need to enumerate
    app3(A,B,CC,WF).

app4(A,B,CC,_WF,_) :- %print(enumerating(CC)),nl,
    append(AA,BB,CC), % will be non-deterministic
    atom_codes(A,AA), atom_codes(B,BB).

b_concat_sequence_of_strings_wf(List,Res,Span,WF) :-
    convert_seq_to_sorted_list(List,SortedList,Done),
    string_conc_aux(Done,SortedList,1,Res,Span,WF).

b_string_append_wf(string(A),string(B),string(C),WF) :-
    app2(A,B,C,WF).

b_string_chars(Str,SeqRes) :- nonvar(Str), Str=string(A), ground(A),!,
    string_chars2(A,SeqRes).

b_string_chars(Str,SeqRes) :- when((ground(Str);ground(SeqRes)),string_chars1(Str,SeqRes)).

b_string_codes(string(A),SeqRes) :- string_codes2(A,SeqRes).

b_string_equal_case_insensitive(string(A),string(B),Res) :-
    str_eq_nocase(A,B,Res).

b_string_is_alphanumerical(string(S),Res) :-
    string_is_alpha_aux(S,Res).

b_string_is_decimal(string(S),Res) :-
    string_is_decimal2(S,Res).

b_string_is_int(string(S),Res) :-
    string_is_int2(S,Res).

b_string_is_number(string(S),Res) :-
    string_is_number2(S,Res).

b_string_join_wf(SplitAtoms,string(Sep),Res,Span,WF) :- string_join2(SplitAtoms,Sep,Res,Span,WF).

b_string_length(SA,int(L)) :-
    greater_than_equal(int(L),int(0)),
    string_len2(SA,L).

b_string_replace(string(S),string(Pat),string(New),Res) :-
    string_replace_aux(S,Pat,New,Res).

b_string_reverse_wf(string(A),string(B),_) :-
    string_reverse2(A,B).

b_string_split_wf(string(A),string(B),R,WF) :-
    string_split2(A,B,R,WF).

b_string_to_int_wf(string(S),int(I),Span,WF) :-
    string_to_int2(S,I,Span,WF).

b_string_to_lowercase(string(A),Res) :- string_to_lowercase2(A,Res).

b_string_to_uppercase(string(A),Res) :- string_to_uppercase2(A,Res).

b_substring_wf(string(S),int(From),int(Len),Res,Span,WF) :-
    substring(S,From,Len,Res,Span,WF).

both_done(_,_,done).

convert_aux(_,ESet,ListOfAtoms,Done) :-
    sort(ESet,SortedESet),
    maplist(get_string,SortedESet,ListOfAtoms),
    Done=true.

convert_b_sequence_to_list_of_atoms(BSeqOfValues,Res,Done) :-
    is_set_value(BSeqOfValues,convert_b_sequence_to_list_of_atoms),
    !,
    expand_custom_set_to_list_gg(BSeqOfValues,ESet,GG,kernel_strings), % GG=guaranteed_ground or not_guaranteed_ground
    (GG=guaranteed_ground -> GrESet=true ; ground_value_check(ESet,GrESet)),
    convert_aux(GrESet,ESet,Res,Done).

convert_b_sequence_to_list_of_atoms(SingleValue,[S],Done) :-
    translate_bvalue(SingleValue,XS),
    add_warning(kernel_strings,'B sequence expected, obtained single value: ',XS),
    ground_value_check(SingleValue,GrValue),
    to_string_aux(GrValue,SingleValue,[],string(S)),
    Done=GrValue.

convert_b_to_prolog_atoms([],[],done).

convert_b_to_prolog_atoms([BAtom|T],[PrologAtom|PT],Done) :-
    convert_b_to_prolog_atoms_aux(BAtom,PrologAtom,DoneAtom),
    convert_b_to_prolog_atoms(T,PT,DoneT),
    both_done(DoneAtom,DoneT,Done).

convert_b_to_prolog_atoms_aux(pred_true,'TRUE',done).

convert_b_to_prolog_atoms_aux(pred_false,'FALSE',done).

convert_b_to_prolog_atoms_aux(string(S),PrologAtom,Done) :-
    convert_b_to_prolog_atoms_aux2(S,PrologAtom,Done).

convert_b_to_prolog_atoms_aux(int(S),PrologAtom,Done) :-
    convert_b_to_prolog_atoms_aux2(S,PrologAtom,Done).

convert_b_to_prolog_atoms_aux2(Atom,Atom,done).

convert_list_to_sorted_list([],Acc,Res,Done) :- sort(Acc,Res), Done=true.

convert_list_to_sorted_list([(int(Idx),El)|T],Acc,Res,Done) :-
    convert_list_to_sorted_list2(Idx,T,[(int(Idx),El)|Acc],Res,Done).

convert_list_to_sorted_list2(_,List,Acc,Res,Done) :- convert_list_to_sorted_list(List,Acc,Res,Done).

convert_prolog_to_b_list(PL,BL,WF) :-
    convert_prolog_to_b_list_aux(PL,1,CPL),
    try_expand_and_convert_to_avl(CPL,CPL2),
    equal_object_wf(CPL2,BL,convert_prolog_to_b_list,WF).

convert_prolog_to_b_list_aux([],_,[]).

convert_prolog_to_b_list_aux([H|T],Index,[(int(Index),CH)|CT]) :-
    convert_prolog_to_b_term(H,CH),
    I1 is Index+1, convert_prolog_to_b_list_aux(T,I1,CT).

convert_prolog_to_b_term(N,R) :-
    number(N),!,
    R=int(N).

convert_prolog_to_b_term(A,R) :-
    atomic(A),!,
    R=string(A).

convert_prolog_to_b_term(A,R) :-
    add_internal_error('Illegal Prolog term: ',convert_prolog_to_b_term(A,R)), R=A.

convert_seq_to_sorted_list(List,SortedList,Done) :-
    custom_explicit_sets:expand_custom_set_to_list(List,ESet,_,string_conc),
    convert_list_to_sorted_list(ESet,[],SortedList,Done).

drop_index((int(_),R),R).

drop_index_with_seq_check([],_,[],_,_).

drop_index_with_seq_check([(int(Nr),R)|T],Expected,[R|TR],Span,WF) :-
    (Nr=Expected -> E1 is Expected+1, drop_index_with_seq_check(T,E1,TR,Span,WF)
    ; ajoin(['Unexpected index: ',Nr,'! Argument for STRING_JOIN is not a sequence! Expected next index to be: '],Msg),
    add_wd_error_set_result(Msg,Expected,TR,[],Span,WF)
).

empty_b_string(string('')).

empty_b_string_atom('').

expand_custom_set_to_ground_list_wf(Set,ExpandedList,DoneGround,PP,WF) :-
    expand_custom_set_to_list_wf(Set,ExpandedList,_Done,PP,WF),
    % _Done nonvar is not sufficient for sorting the list; indices might be unbound
    ground_value_check(ExpandedList,DoneGround).

extract_codes([],_,[]).

extract_codes([(int(Nr),int(Code))|T],N,[Code|CT]) :-
    (Nr==N -> true ; add_error(extract_codes,'Unexpected index: ',(Nr,N))),
    N1 is N+1, extract_codes(T,N1,CT).

finish_join(_Done,PL,Seperator,Result,WF) :-
    insert_sep(PL,Seperator,PL2),
    ajoin(PL2,Atom),
    equal_object_optimized_wf(Result,string(Atom),string_join,WF).

format_to_b_string(string(FormatString),BSeqOfValues,Res) :-
    convert_b_sequence_to_list_of_atoms(BSeqOfValues,ListOfAtoms,Done),
    format_to_string_aux(Done,FormatString,ListOfAtoms,Res).

format_to_string_aux(_,FormatString,ListOfAtoms,Res) :-
    format_to_codes(FormatString,ListOfAtoms,Codes),
    atom_codes(Atom,Codes),
    Res = string(Atom).

generate_char_seq([],_,[]).

generate_char_seq([Code|T],Nr,[(int(Nr),string(CS))|TSeq]) :-
    atom_codes(CS,[Code]),
    N1 is Nr+1, generate_char_seq(T,N1,TSeq).

generate_code_sequence([],_,[]).

generate_code_sequence([Code|T],Nr,[(int(Nr),int(Code))|TSeq]) :-
    N1 is Nr+1, generate_code_sequence(T,N1,TSeq).

get_string((_,string(S)),R) :- !,R=S.

get_string((_,X),R) :- !,to_string_aux(X,[],string(R)).

get_string(X,R) :-
    translate_bvalue(X,XS),
    add_warning(kernel_strings,'B sequence expected, obtained set containing: ',XS),
    to_string_aux(X,[],string(R)).

incompatible_goal((A,B),S,Res) :-
    (incompatible_goal(A,S,Res) -> true ; incompatible_goal(B,S,Res)).

incompatible_goal(kernel_strings:strint_to_int3(S2,Res2,_,_),S,Res) :-
    number(Res2),
    S==S2, Res2 \= Res.

insert_sep([],_,[]).

insert_sep([H],_,R) :- !, R=[H].

insert_sep([H|T],Sep,[H,Sep|IT]) :- insert_sep(T,Sep,IT).

int_to_b_string(int(I),S) :- int_to_string2(I,S).

int_to_dec_b_string(int(I),int(Prec),S) :- int_to_dec_string2(I,Prec,S).

int_to_dec_string2(I,Prec,String) :-
    Prec=<0,
    !,
    IP is I * (10^abs(Prec)),
    int_to_string2(IP,String).

int_to_dec_string2(I,Prec,String) :- %Prec>0,
    PowTen is 10^Prec,
    IntVal is I // PowTen,
    number_codes(IntVal,IVC),
    ((IntVal=0, I<0) -> Prefix = [45|IVC] % need to add leading -
    ; Prefix = IVC),
    DecVal is abs(I) mod PowTen,
    number_codes(DecVal,DVC),
    length(DVC,Digits),
    NrZeros is Prec-Digits,
    length(Zeros,NrZeros),
    maplist(is_zero,Zeros),
    append(Zeros,DVC,Suffix),
    append(Prefix,[46|Suffix],Codes), % 46 is the dot .
    atom_codes(Atom,Codes),
    String = string(Atom).

int_to_string2(Num,Res) :-
    number_codes(Num,C),
    atom_codes(S,C), Res=string(S).

integer_number_codes(C,S,Res,Span,WF) :-
    number_codes(Num,C),
    (integer(Num) -> Res=Num
    ; %add_error_and_fail(external_functions,'### String represents a floating point number (expected integer): ',S)).
    add_wd_error_set_result('String represents a floating point number (expected integer): ',S,Res,0,Span,WF)).

is_alpha_numerical(Code) :- Code >= 48, Code =< 57. % 0-9

is_alpha_numerical(Code) :- Code >= 65, Code =< 90. % A-Z

is_alpha_numerical(Code) :- Code >= 97, Code =< 122. % a-z

is_alphnum_aux([]).

is_alphnum_aux([H|T]) :- is_alpha_numerical(H),is_alphnum_aux(T).

is_dec_nr([H|T]) :- is_digit(H),!,is_dec_nr2(T).

is_dec_nr([45,H|T]) :- % 45 = minus
    is_digit(H),is_dec_nr2(T).

is_dec_nr2([H|T]) :- is_digit(H),!,is_dec_nr2(T).

is_dec_nr2([46,D|T]) :- % 46 = dot
    is_digit(D),
    is_dec_nr3(T).

is_dec_nr3([]).

is_dec_nr3([H|T]) :- is_digit(H),is_dec_nr3(T).

is_digit(X) :- X>=48, X=<57.

is_zero(48). % ascii code of zero 0

l_eq_upcase([],[]).

l_eq_upcase([H1|T1],[H2|T2]) :-
    (H1=H2 -> true ; upcase(H1,HU), upcase(H2,HU)),
    l_eq_upcase(T1,T2).

l_lowcase([],[]).

l_lowcase([H|T],[HU|TU]) :- simple_lowcase(H,HU), l_lowcase(T,TU).

l_upcase([],[]).

l_upcase([H|T],[HU|TU]) :- upcase(H,HU), l_upcase(T,TU).

normalise_value_for_to_string(avl_set(A),R) :- !, R=avl_set(A).

normalise_value_for_to_string((A,B),R) :- !, R=(NA,NB),
    normalise_value_for_to_string(A,NA),
    normalise_value_for_to_string(B,NB).

normalise_value_for_to_string(A,R) :- normalise_value_for_var(to_b_string,A,R).

not_suffix_atom(SepCodes,Atom) :- \+ suffix_atom(SepCodes,Atom).

real_to_dec_b_string(Real,int(Prec),Res,Span) :-
    is_real(Real,RealNr),
    real_to_dec_b_string2(RealNr,Prec,Res,Span).

real_to_dec_b_string2(RealNr,Prec,Res,Span) :-
    Prec<0,!,
    add_error(kernel_strings,'Precision must not be negative:',Prec,Span),
    real_to_dec_b_string2(RealNr,0,Res,Span).

real_to_dec_b_string2(RealNr,Prec,Res,_) :-
    number_codes(Prec,PC),
    append(["~",PC,"f"],FormatStr), atom_codes(Format,FormatStr),
    % print(f(Format)),nl, write_term(RealNr,[float_format(Format)]),
    with_output_to_codes(
    %write_term(Stream,RealNr,[float_format(Format)]), % SWI Prolog does not recognise the float_format option
    format(Stream,Format,[RealNr]), % SICStus and SWI differ when Precision is 0; SICStus prints .0 SWI does not
    Stream,
    Codes, []),
    atom_codes(ResStr,Codes),
    Res=string(ResStr).

replace_pat(Pat,NewStr,Res) --> Pat, !, {append(NewStr,TR,Res)}, replace_pat(Pat,NewStr,TR).

replace_pat(Pat,RepStr,[H|T]) --> [H],!, replace_pat(Pat,RepStr,T).

replace_pat(_,_,[]) --> [].

simple_lowcase(H,R) :- 0'A =< H, H =< 0'Z, !, R is H+0'a-0'A.

simple_lowcase(Code,Code).

split3([],_,_,MatchSoFarIn,MatchSoFarRes,R) :- !,
    MatchSoFarIn=[], % match complete, ground tail of match
    atom_chars(Atom,MatchSoFarRes),R=[Atom].

split3([H|List],H,Sep,MatchSoFarIn,MatchSoFarRes,Res) :-
    append(Sep,Tail,List),
    !, % we have a match with a separator
    MatchSoFarIn=[], % match complete
    atom_chars(Atom,MatchSoFarRes),
    Res=[Atom|R2], split3(Tail,H,Sep,NewMatch,NewMatch,R2).

split3([H|T],HS,Sep,[H|MatchSoFarIn],MatchSoFarRes,Res) :- % no match
    split3(T,HS,Sep,MatchSoFarIn,MatchSoFarRes,Res).

split4(Done,_SepCodes2,_PL,Seperator,Atom,SplitAtomList,WF) :-
    var(Done),
    !,
    % we can now compute forwards anyhow; ignore backwards direction
    string_split_forward(Atom,Seperator,SplitAtomList,WF).

split4(_,SepCodes2,PL,Seperator,Atom,_,_) :-
    maplist(not_suffix_atom(SepCodes2),PL), % check that seperator occurs in no split atom: e.g. STRING_SPLIT(r,"_") = ["a","_","c"] should fail
    insert_sep(PL,Seperator,PL2),
    ajoin(PL2,Atom).

split_atom_string(Atom,Sep,SplitList) :-
    atom_chars(Sep,SepAscii),
    (SepAscii=[] -> SplitList = [Atom]
    ; SepAscii = [H|T], atom_chars(Atom,ListAscii),
    split3(ListAscii,H,T,Match,Match,SplitList)).

str_eq_nocase(A,A,Res) :- !, Res=pred_true.

str_eq_nocase(A,B,Res) :-
    atom_codes(A,CA),
    atom_codes(B,CB),
    (l_eq_upcase(CA,CB) -> Res=pred_true ; Res=pred_false).

string_chars1(Str,SeqRes) :- nonvar(Str), Str=string(A), ground(A),!,
    % construct sequence from string:
    string_chars2(A,SeqRes).

string_chars1(Str,SeqRes) :-
    expand_custom_set_to_list(SeqRes,ExpandedAtomList,Done,string_chars1),
    string_chars3(Str,SeqRes,ExpandedAtomList,Done).

string_chars2(A,SeqRes) :- atom_codes(A,AA), generate_char_seq(AA,1,CharSeq),
    equal_object_optimized(CharSeq,SeqRes,string_chars2).

string_chars3(Str,SeqRes,_ExpandedAtomList,_Done) :-
    % construct sequence from string:
    nonvar(Str), Str=string(A), ground(A),
    !,
    string_chars2(A,SeqRes).

string_chars3(Str,_SeqRes,ExpandedAtomList,Done) :-
    nonvar(Done),
    % construct string from sequence:
    !,
    sort(ExpandedAtomList,SL),
    maplist(drop_index,SL,IL),
    convert_b_to_prolog_atoms(IL,PL,Done2),
    when(nonvar(Done2),
    (ajoin(PL,Atom),
    equal_object(Str,string(Atom),b_string_chars))).

string_chars3(Str,SeqRes,ExpandedAtomList,Done) :- % Str is only partially instantiated
    when((ground(Str);nonvar(Done)),string_chars3(Str,SeqRes,ExpandedAtomList,Done)).

string_codes2(A,SeqRes) :-
    nonvar(A),
    !,
    string_codes4(A,SeqRes).

string_codes2(A,SeqRes) :-
    SeqRes==[],
    !,
    empty_b_string_atom(A).

string_codes2(A,SeqRes) :- expand_custom_set_to_list(SeqRes,SeqList,_,string_codes2),
    when((nonvar(A);ground(SeqList)), string_codes3(A,SeqList)).

string_codes3(A,SeqRes) :-
    nonvar(A),
    !,
    string_codes4(A,SeqRes).

string_codes3(A,SeqRes) :-
    sort(SeqRes,SSeqRes),
    extract_codes(SSeqRes,1,Codes),
    atom_codes(A,Codes).

string_codes4(A,SeqRes) :-
    atom_codes(A,AA), generate_code_sequence(AA,1,CodeSeq),
    equal_object_optimized(CodeSeq,SeqRes,string_codes4).

string_conc_aux(_,List,Idx1,TRes,Span,WF) :-
    string_conc_aux2(List,Idx1,TRes,Span,WF).

string_conc_aux2([],_,string(''),_,_WF).

string_conc_aux2([(int(IdxH),H)|T],Idx,Res,Span,WF) :-
    (T==[] -> Res=H % values are strings; no need to call equal_object
    ; IdxH=Idx ->
    Idx1 is Idx+1,
    string_conc_aux2(T,Idx1,TRes,Span,WF),
    b_string_append_wf(H,TRes,Res,WF)
    ; add_wd_error_span('Illegal index in sequence of strings for concatenation:',IdxH,Span,WF)
).

string_is_alpha_aux(S,Res) :-
    atom_codes(S,Codes),
    (Codes \= [],
    is_alphnum_aux(Codes)
    -> Res=pred_true
    ; Res=pred_false).

string_is_decimal2(S,Res) :-
    atom_codes(S,C),
    (is_dec_nr(C) -> Res=pred_true ; Res=pred_false).

string_is_int2(S,Res) :-
    atom_codes(S,C),
    catch((
    number_codes(Num,C),
    (integer(Num) -> Res=pred_true ; Res=pred_false)
    ), error(syntax_error(_),_), Res=pred_false).

string_is_number2(S,Res) :-
    atom_codes(S,C),
    catch((
    number_codes(_Num,C),
    Res=pred_true
    ), error(syntax_error(_),_), Res=pred_false).

string_join2(SplitAtomList,Seperator,Result,Span,WF) :-
    expand_custom_set_to_ground_list_wf(SplitAtomList,ExpandedSplitAtomList,GrDone,string_join2,WF),
    % indices have to be ground for sorting, and strings for joining
    string_join3(Result,Seperator,SplitAtomList,GrDone,ExpandedSplitAtomList,Span,WF).

string_join3(Result,Seperator,_SplitAtomList,_Done,ExpandedSplitAtomList,Span,WF) :-
    %ExpandedSplitAtomList \= [], !, % commented out this means that STRING_JOIN([],sep) =
    % result of split("",sep) --> [""] : this is not the empty list; i.e., STRING_JOIN is then no longer injective
    sort(ExpandedSplitAtomList,SL),
    drop_index_with_seq_check(SL,1,IL,Span,WF),
    convert_b_to_prolog_atoms(IL,PL,Done2),
    finish_join(Done2,PL,Seperator,Result,WF).

string_len2(SA,L) :-
    L==0,!,
    empty_b_string(SA).

string_len2(string(A),L) :-
    string_len3(A,L).

string_len3(A,L) :-
    L==0,
    !,
    empty_b_string_atom(A).

string_len3(A,L) :-
    string_len4(A,L).

string_len4(A,L) :-
    atom_length(A,LL), LL=L. % delay unification due to bug in SICStus atom_length