17:- module(string, []). 18
19:- meta_predicate index_of_first_failure(*,2,*,*,*). 20:- meta_predicate index_of_first_success(*,2,*,*,*). 21
22
23
26
27as_string_upper(C,SN):- compound(C),\+ is_list(C),functor(C,_P,A),arg(A,C,S),!, as_string_upper(S,SN).
28as_string_upper(S,U):- to_prolog_string_anyways(S,D),string_upper(D,U).
29
30is_characterp(X):-var(X),!,fail.
31is_characterp('#\\'(V)):- nonvar(V).
32
33is_stringp(X):- string(X),nop(dbginfo(is_stringp(X))).
34is_stringp(X):- is_lisp_string(X).
35
36is_lisp_string(X):-var(X),!,fail.
37is_lisp_string('$ARRAY'([_N],claz_base_character,List)):- nonvar(List).
38
41
42f_string(O,S):- to_prolog_string(O,PLS),to_lisp_string(PLS,S).
43
45to_prolog_string(SS,SS):- notrace(string(SS)),!.
46to_prolog_string(SS,SS):- notrace(var(SS)),!,break.
47to_prolog_string([],"").
48to_prolog_string('$ARRAY'(_N,claz_base_character,List),SS):- !,always(lisp_chars_to_pl_string(List,SS)),!.
50to_prolog_string('#\\'(Char),Str):- !, f_char_code('#\\'(Char),Code),text_to_string([Code],Str).
51to_prolog_string(S,SN):- is_symbolp(S),!,pl_symbol_name(S,S2),to_prolog_string(S2,SN).
52
54to_prolog_string_if_needed(L,Loc):- \+ string(L),!,always(to_prolog_string_anyways(L,Loc)).
56to_prolog_string_anyways(I,O):- atom(I),upcase_atom(I,I),!,atom_string(I,O).
57to_prolog_string_anyways(I,O):- is_pathnamep(I),pl_namestring(I,O),!.
58to_prolog_string_anyways(I,O):- to_prolog_string(I,O),!.
59to_prolog_string_anyways(I,O):- is_classp(I),claz_to_symbol(I,Symbol),!,to_prolog_string_anyways(Symbol,O).
60to_prolog_string_anyways(I,O):- always(atom_string(I,O)),!.
61
62
63
68
69to_lisp_string('$ARRAY'([N],claz_base_character,List),'$ARRAY'([N],claz_base_character,List)):-!.
70to_lisp_string(Text,'$ARRAY'([*],claz_base_character,List)):- always((catch(text_to_string(Text,Str),E,
71 (dumpST,userout(E),fail)),string_chars(Str,Chars),maplist(make_lisp_character,Chars,List))).
72
74wl:coercion(In, claz_prolog_string, Out):- to_prolog_string(In,Out).
75wl:coercion(In, claz_string, Out):- f_string(In,Out).
76wl:coercion(In, claz_character, Out):- make_lisp_character(In,Out).
77wl:coercion(In, claz_string, Out):- f_string(In,Out).
78wl:coercion(In, claz_cons, Out):- functor(In,_F,A),arg(A,In,Out),is_list(Out).
79
80wl:coercion(List, object(_,'$ARRAY'(A1,A2)), '$ARRAY'(A1,A2,List)).
81wl:coercion(In, claz_sequence, Out):- is_stringp(In),to_lisp_string(In,Out).
82wl:coercion(In, sequence(string,'$ARRAY'(A1,A2)), List):- string(In),to_lisp_string(In,'$ARRAY'(A1,A2,List)).
83wl:coercion(In, sequence(string,'$ARRAY'(A1,A2)), List):- is_stringp(In),to_lisp_string(In,'$ARRAY'(A1,A2,List)).
84
85wl:coercion([H|T], object(Cons,_), [H|T]):- Cons==claz_cons.
86wl:coercion([H|T], sequence(claz_cons,claz_cons), [H|T]):-!.
87
89index_of_first_success(N,Pred,[X|XX],[Y|YY],R):- !,
90 ( call(Pred,X,Y) -> R = N;
91 (N2 is N+1, index_of_first_success(N2,Pred,XX,YY,R))).
92index_of_first_success(_,_,_,_,[]).
94index_of_first_failure(N,Pred,[X|XX],[Y|YY],R):- !,
95 ( call(Pred,X,Y) -> R = N;
96 (N2 is N+1, index_of_first_failure(N2,Pred,XX,YY,R))).
97index_of_first_failure(_,_,_,_,[]).
98
100
102(wl:init_args(2,string_c62)).
103wl:type_checked(f_string_c62(claz_cons,claz_cons,keys,index)).
104f_string_c62(X,Y,Keys,R):-
105 range_1_and_2(X,Y,Keys,XR,YR,Start1),
106 index_of_first_success(Start1,@>,XR,YR,R).
107
108
110(wl:init_args(2,string_c62_c61)).
111wl:type_checked(f_string_c62_c61(claz_cons,claz_cons,keys,index)).
112f_string_c62_c61(X,Y,Keys,R):-
113 range_1_and_2(X,Y,Keys,XR,YR,Start1),
114 index_of_first_success(Start1,@>=,XR,YR,R).
115
116
118(wl:init_args(2,string_c60)).
119wl:type_checked(f_string_c60(claz_cons,claz_cons,keys,index)).
120f_string_c60(X,Y,Keys,R):-
121 range_1_and_2(X,Y,Keys,XR,YR,Start1),
122 index_of_first_success(Start1,@<,XR,YR,R).
123
124
126(wl:init_args(2,string_c60_c61)).
127wl:type_checked(f_string_c60_c61(claz_cons,claz_cons,keys,index)).
128f_string_c60_c61(X,Y,Keys,R):-
129 range_1_and_2(X,Y,Keys,XR,YR,Start1),
130 index_of_first_success(Start1,@=<,XR,YR,R).
131
133(wl:init_args(2,string_c47_c61)).
134wl:type_checked(f_string_c47_c61(claz_cons,claz_cons,keys,index)).
135f_string_c47_c61(X,Y,Keys,R):-
136 range_1_and_2(X,Y,Keys,XR,YR,Start1),
137 index_of_first_success(Start1,\==,XR,YR,R).
138
140(wl:init_args(2,string_lessp)).
141wl:type_checked(f_string_lessp(claz_cons,claz_cons,keys,index)).
142f_string_lessp(X,Y,Keys,R):-
143 range_1_and_2(X,Y,Keys,XR,YR,Start1),
144 index_of_first_success(Start1,char_lessp,XR,YR,R).
145
147(wl:init_args(2,string_not_lessp)).
148wl:type_checked(f_string_not_lessp(claz_cons,claz_cons,keys,index)).
149f_string_not_lessp(X,Y,Keys,R):-
150 range_1_and_2(X,Y,Keys,XR,YR,Start1),
151 index_of_first_failure(Start1,char_lessp,XR,YR,R).
152
154(wl:init_args(2,string_greaterp)).
155wl:type_checked(f_string_greaterp(claz_cons,claz_cons,keys,index)).
156f_string_greaterp(X,Y,Keys,R):-
157 range_1_and_2(X,Y,Keys,XR,YR,Start1),
158 index_of_first_success(Start1,char_greaterp,XR,YR,R).
159
161(wl:init_args(2,string_not_greaterp)).
162wl:type_checked(f_string_not_greaterp(claz_cons,claz_cons,keys,index)).
163f_string_not_greaterp(X,Y,Keys,R):-
164 range_1_and_2(X,Y,Keys,XR,YR,Start1),
165 index_of_first_failure(Start1,char_greaterp,XR,YR,R).
166
167char_lessp(X,Y):- to_prolog_char(X,XX),to_prolog_char(Y,YY), char_type(XX,upper(XXX)),char_type(YY,upper(YYY)), XXX@<YYY.
168char_greaterp(X,Y):- to_prolog_char(X,XX),to_prolog_char(Y,YY), char_type(XX,upper(XXX)),char_type(YY,upper(YYY)), XXX@>YYY.
169char_same(X,Y):- to_prolog_char(X,XX),to_prolog_char(Y,YY), char_type(XX,upper(XXX)),char_type(YY,upper(YYY)), XXX==YYY.
170char_same(X,Y):- to_prolog_char(X,XX),to_prolog_char(Y,YY), XX==YY.
171
172char_exact(X,Y):- to_prolog_char(X,XX),to_prolog_char(Y,YY), XX==YY.
173
174
176wl:type_checked(f_string_equals(claz_cons,claz_cons,keys,boolean)).
177(wl:init_args(2,string_equals)).
178f_string_equals(X,Y,Keys,R):-
179 range_1_and_2(X,Y,Keys,XR,YR,Start1),
180 index_of_first_failure(Start1,char_same,XR,YR,Index),
181 t_or_nil(Index==[],R).
182
183
185(wl:init_args(2,string_not_equal)).
186wl:type_checked(f_string_not_equal(claz_cons,claz_cons,keys,index)).
187f_string_not_equal(X,Y,Keys,R):-
188 range_1_and_2(X,Y,Keys,XR,YR,Start1),
189 index_of_first_failure(Start1,char_same,XR,YR,R).
190
191
193wl:type_checked(f_string_c61(claz_cons,claz_cons,keys,boolean)).
194(wl:init_args(2,string_c61)).
195f_string_c61(X,Y,Keys,R):-
196 range_1_and_2(X,Y,Keys,XR,YR,Start1),
197 index_of_first_failure(Start1,char_exact,XR,YR,Index),
198 t_or_nil(Index==[],R).
199
200
204f_char(String,Index,Char):-f_aref(String,[Index],Char).
205
206
207
208
209
210:- fixup_exports.