1:- module(type_stringy,[stringy/1]).    2
    3:- current_module(arithmetic_types) -> true ; use_module(library(arithmetic_types)).    4% uses operators and slice/indexing support from type_list
    5% for indexing and slicing support
    6:- current_module(type_list) 
    7	-> true 
    8	;  reexport(library(type_list)).      % reexport for operators
    9
   10:- arithmetic_function(string/1).         % term to string conversion
   11:- arithmetic_function([]/1).             % indexing (char) and slicing (substring)
   12:- arithmetic_function([]/2).   13:- arithmetic_function(\\ /2).            % concat
   14:- arithmetic_function(string_length/1).  % "builtin", no code required
   15:- arithmetic_function(find/2).           % find a substring (like Python)
   16
   17%
   18% most string functions work equally well on atoms
   19%
   20stringy(T) :- (string(T) ; atom(T)), !.
   21
   22%
   23% Function: string conversion
   24%
   25string(Term,S)   :- 
   26	(string(Term) -> S=Term ; term_string(Term,S)).  % string function is idempotent
   27
   28%
   29% Function: string indexing and slicing
   30%
   31[](St, St) :- stringy(St).
   32[]([B:E],St,X) :- stringy(St),
   33	string_length(St,Len),  % St is a string
   34	slice_parameters(B:E,Len,SB,SL), !,
   35	sub_string(St, SB, SL, _, X).            % slicing evaluates to a string
   36[]([Ix],St,X) :- stringy(St),
   37	string_length(St,Len),
   38	index_parameters(Ix,Len,I),
   39	sub_string(St, I, 1, _, SS), !,
   40	string_chars(SS,[X]).                    % indexing evaluates to a char
   41
   42%
   43% Function: string concat (\\)
   44%
   45\\(S1,S2,R) :- stringy(S1), stringy(S2),     % arguments must be stringy
   46	string_concat(S1,S2,R), !.               % deterministic concat
   47
   48%
   49% Function: find - returns position of substring in string (like Python)
   50%
   51find(Sub,S,R) :- stringy(Sub), stringy(S),   % arguments must be stringy
   52	(sub_string(S,R,_,_,Sub)
   53	 -> true
   54	 ; R= -1  % not found value
   55	)