/**
* This module contains strategies for operating on strings.
*
* In Stratego, strings are primitive terms, separate from characters
* and character lists. It is recommended that all strings contain only
* ISO-8859-1 (Latin1) characters.
*
* @author Eelco Visser <visser@acm.org>
* @author Karl Trygve Kalleberg <karltk@strategoxt.org>
*/
module term/string
imports
collection/list/common
strategy/conditional
strategy/iteration
system/io/file
/**
* Primitives
*/
strategies
/**
* Generates a unique new string of the form 'c_d',
* where c is one char and d is a positive integer.
*/
new = prim("SSL_new")
/**
* Generates a unique new string with user-defined prefix
* the form 'sd', where s is a string and d is a positive integer.
* The produced string is *always* unique across a program run.
*
* The prefix comes in front of an increasing number, which is
* separately maintained and started at 0 for each prefix.
*
* Examples (results are shown in comment)
* <newname; debug> "a" // produces "a0"
* ; <newname; debug> "a" // produces "a1"
* ; <newname; debug> "a" // produces "a2"
* ; <newname; debug> "b" // produces "b0"
* ; <newname; debug> "b" // produces "b1"
* ; <newname; debug> "b_2" // produces "b_20"
* ; <newname; debug> "b_2" // produces "b_21"
* ; <newname; debug> "b_a" // produces "b_a0"
* ; <newname; debug> "b_a" // produces "b_a1"
* ; <newname; debug> "a_" // produces "a_0"
* ; <newname; debug> "a_1" // produces "a_10"
*/
newname = ?prefix; prim("SSL_newname", prefix)
/**
* Predicate that checks if the supplied term is a string.
*
* @type String -> String
*/
is-string = ?x; prim("SSL_is_string", x)
/**
* Predicate that checks if the supplied term is a printable character.
*
* @type Char -> Char
*/
is-char = is-int ; is-ascii
/**
* Implodes a list of chars to a string.
*
* @type List(Char) -> String
*/
implode-string = ?x; prim("SSL_implode_string", x)
/**
* Explodes a String to a list of chars.
*
* @type String -> List(Char)
*/
explode-string = ?x; prim("SSL_explode_string", x)
/**
* Wraps a strategy on a list of chars in a strategy on a string.
*
* @param List(Char) -> List(Char)
* @type String -> String
*/
string-as-chars(s) =
explode-string
; s
; implode-string
strategies
/**
* Concats a tuple of two Strings.
*
* @type String * String -> String
*/
conc-strings =
?(_,_) ; strcat
<+ ?""#(xs) ; <concat-strings>xs
/**
* Concats a tuple of two Strings.
*
* @warning doesn't accept tuples with more than two string.
* @type String * String -> String
* @inc strcat-1
* @inc strcat-2
* @inc strcat-3
* @inc strcat-4
*/
strcat =
?(str1, str2); prim("SSL_strcat", str1, str2)
/**
* Concats a list of Strings
*
* @type List(String) -> String
* @inc concat-strings-1
* @inc concat-strings-2
* @inc concat-strings-3
* @inc concat-strings-4
*/
concat-strings =
?strings; prim("SSL_concat_strings", strings)
strategies
/**
* Returns the number of characters in a string.
*
* @type String -> Int
*/
string-length =
strlen
/**
* Returns the number of characters in a string.
*
* @type String -> Int
* @inc strlen-1
* @inc strlen-2
* @inc strlen-3
*/
strlen =
?str; prim("SSL_strlen", str)
strategies
/**
* Escapes double quotes, backslash and linefeed to C like escape sequences.
*
* @type String -> String
* @inc escape-test1
*/
escape = string-as-chars(escape-chars)
/**
* Escapes double quotes, backslash and linefeed to C like escape sequences.
*
* @type List(Char) -> List(Char)
*/
escape-chars =
escape-chars(Escape)
/** @internal */
escape-chars(s) =
rec x(
(s; [id, id | x])
<+ [id | x]
<+ []
)
/**
* Unescapes double quotes, backslash, linefeed and tabs.
*
* @type String -> String
* @inc unescape-test1
* @inc unescape-test2
* @inc unescape-test3
* @inc unescape-test4
*/
unescape = string-as-chars(unescape-chars)
/**
* Unescapes characters using a specified unescape strategy.
*
* @param List(Char) -> List(Char)
* @type List(Char) -> List(Char)
*/
unescape-chars(s) =
rec x(
try(s)
; ([id | x] <+ [])
)
/**
* Unescapes double quotes, backslash, linefeed and tabs.
*
* @type List(Char) -> List(Char)
*/
unescape-chars =
unescape-chars(UnEscape)
/**
* @type List(Char) -> List(Char)
*/
Escape =
Escape-double-quote
+ Escape-backslash
+ Escape-linefeed
+ Escape-carriage-return
/** @internal */
Escape-double-quote : ['"' | cs ] -> ['\', '"' | cs ]
/** @internal */
Escape-single-quote : ['\'' | cs ] -> ['\', '\'' | cs ]
/** @internal */
Escape-backslash : ['\' | cs ] -> ['\', '\' | cs ]
/** @internal */
Escape-linefeed : ['\n' | cs ] -> ['\', 'n' | cs ]
/** @internal */
Escape-carriage-return : ['\r' | cs ] -> ['\', 'r' | cs ]
/**
* @type List(Char) -> List(Char)
*/
UnEscape =
UnEscape-double-quote
+ UnEscape-backslash
+ UnEscape-linefeed
+ UnEscape-tab
+ UnEscape-carriage-return
/** @internal */
UnEscape-double-quote : ['\', '"' | cs ] -> ['"' | cs ]
/** @internal */
UnEscape-single-quote : ['\', '\'' | cs ] -> ['\'' | cs ]
/** @internal */
UnEscape-backslash : ['\', '\' | cs ] -> ['\' | cs ]
/** @internal */
UnEscape-carriage-return : ['\', 'r' | cs ] -> ['\r' | cs ]
/** @internal */
UnEscape-linefeed : ['\', 'n' | cs ] -> ['\n' | cs ]
/** @internal */
UnEscape-tab : ['\', 't' | cs ] -> ['\t' | cs ]
/** @internal */
UnEscape(|c) :
['\', c | cs ] -> [c | cs ]
strategies
/** @internal */
escape(esc : (List(String) -> List(String)) * List(String) -> List(String) ) =
explode-string;
rec x(esc(x) <+ [id | x] <+ []);
implode-string
/**
* @inc escape-test2
*/
cify = escape(Cify)
/** @internal */
uncify = escape(UnCify)
/** @internal */
UnCify(x) = UnCify1(x) <+ UnCify2(x) <+ UnCify3(x)
rules
/** @internal */
Cify(x) : ['\'' | cs] -> ['_', 'p', '_' | <x>cs]
/** @internal */
Cify(x) : ['-' | cs] -> ['_' | <x>cs]
/** @internal */
Cify(x) : ['_' | cs] -> ['_', '_' | <x>cs]
/** @internal */
Cify(x) : ['"' | cs] -> ['_', 'q', '_' | <x>cs]
/** @internal */
Cify(x) : ['\' | cs] -> ['_', 'b', '_' | <x>cs]
/** @internal */
UnCify1(x) : ['_', 'b', '_' | cs] -> ['\' | <x>cs]
/** @internal */
UnCify1(x) : ['_', 'q', '_' | cs] -> ['"' | <x>cs]
/** @internal */
UnCify1(x) : ['_', 'p', '_' | cs] -> ['\'' | <x>cs]
/** @internal */
UnCify2(x) : ['_', '_' | cs] -> ['_' | <x>cs]
/** @internal */
UnCify3(x) : ['_' | cs] -> ['-' | <x>cs]
/**
* Quoting Literals
*/
strategies
/**
* param () -> Char
* @type String -> String
*/
quote(c) = string-as-chars(quote-chars(c))
/**
* param () -> Char
* @type List(Char) -> List(Char)
*/
quote-chars(c) = <quote-chars> (<c> (), <id>)
/**
* @type Char * List(Char) -> List(Char)
*/
quote-chars:
(c, chars) -> <conc> ([c | chars], [c])
/**
* Adds single quotes to the start and end of a list
* of characters.
*
* @type List(Char) -> List(Char)
*/
single-quote-chars = <quote-chars> ('\'', <id>)
/**
* Adds double quotes to the start and end of a
* list of characters.
*
* @type List(Char) -> List(Char)
*/
double-quote-chars = <quote-chars> ('"' , <id>)
/**
* @inc single-quote-test
*/
single-quote = string-as-chars(single-quote-chars)
/**
* Adds double quotes to the start and end of
* a string.
*
* @type String -> String
*/
double-quote = string-as-chars(double-quote-chars)
/**
* Unquoting
*/
strategies
/**
* Removes the first and last character of a string.
* The characters must satisfy s.
*
* @param Char ->? _
* @type String -> String
*/
unquote(s) =
string-as-chars(unquote-chars(s))
/**
* Removes the first and last character of a string.
* The first character must satisfy s1.
* The last character must satisfy s2.
*
* @param Char ->? _
* @param Char ->? _
* @type String -> String
*/
unquote(s1, s2) =
string-as-chars(unquote-chars(s1, s2))
/**
* Removes the first and last character of a list of characters.
* The characters must satisfy s.
*
* @param Char ->? _
* @type List(Char) -> List(Char)
*/
unquote-chars(s) =
unquote-chars(s, s)
/**
* Removes the first and last character of a list of characters.
* The first character must satisfy s1.
* The last character must satisfy s2.
*
* @param Char ->? _
* @param Char ->? _
* @type List(Char) -> List(Char)
*/
unquote-chars(s1, s2) =
where(Hd; s1)
; where(last; s2)
; Tl
; init
/**
* Removes single quotes from the start and end of a list
* of characters. Fails if the list is not properly
* quoted.
*
* @type List(Char) -> List(Char)
*/
un-single-quote-chars = unquote-chars(?'\'')
/**
* Removes double quotes from the start and end of a list
* of characters. Fails if the list is not properly
* quoted.
*
* @type List(Char) -> List(Char)
*/
un-double-quote-chars = unquote-chars(?'"' )
/**
* Removes single quotes from the start and end of a string
* Fails if the string is not properly quoted.
*
* @type String -> String
*/
un-single-quote = string-as-chars(un-single-quote-chars)
/**
* Removes double quotes from the start and end of a string
* Fails if the string is not properly quoted.
*
* @type String -> String
*/
un-double-quote = string-as-chars(un-double-quote-chars)
strategies
/** Predicate that checks if a string is double quoted, i.e. quoted
* with double quotation marks (").
*
* @inc is-double-quote 1
* @inc is-double-quote 2
* @inc is-double-quote 3
* @inc is-double-quote 4
* @inc is-double-quote 5
* @inc is-double-quote 6
*
* @type String -> String
*/
is-double-quoted =
is-quoted(|'"')
/**
* Predicate that checks a string is quoted with single quotes.
*
* @type String -> String
*/
is-single-quoted =
is-quoted(|'\'')
/**
* Predicate that checks if a character list is double quoted. That
* is, if the first and last character are both double quotes.
*
* @type List(Char) -> List(Char)
*/
is-double-quoted-chars =
is-quoted-chars(|'"')
/**
* Predicate that checks if a character list is single quoted. That is,
* if the first and last character are both single quotes.
*
* @type List(Char) -> List(Char)
*/
is-single-quoted-chars =
is-quoted-chars(|'\'')
/**
* Predicate that checks if a string is quoted with the given character.
*
* The character c is the quotation character to check for.
*
* @param Char
* @type String -> String
*/
is-quoted(|c) =
where(
explode-string
; is-quoted-chars(|c)
)
/**
* Predicate that checks if a list of characters is quoted with
* the character given by the term argument. That is, if the
* first and last character of the list are both equal to c.
*
* @param Char
* @type List(Char) -> List(Char)
*/
is-quoted-chars(|c) =
where(?[c | <last>]; ?c)
strategies
/**
* @obsolete use string-to-int
*/
string-to-num =
obsolete(!"string-to-num; use string-to-int")
; string-to-int
strategies
/**
* Converts all characters of this string to lower case
*
* @type String -> String
*/
lower-case = string-as-chars(lower-case-chars)
/**
* Converts all characters of this string to upper case
*
* @inc upper-case-test
*/
upper-case = string-as-chars(upper-case-chars)
/**
* Converts a list of characters to lower case.
*
* Example: <explode-string ; lower-case-char ; implode-string> "STRATEGO" => "stratego"
*
* @type List(Char) -> List(Char)
*/
lower-case-chars = map(to-lower)
/**
* Converts a list of characters to upper case.
*
* Example: <explode-string ; upper-case-chars ; implode-string> "stratego" => "STRATEGO"
*
* @type List(Char) -> List(Char)
*/
upper-case-chars = map(to-upper)
strategies
/**
* Breaks a string into tokens.
*
* Given a list of possible delimiters (characters that
* separate tokens), string-tokenize returns a list of
* tokens for a given string.
*
* @param List of separate characters
* @type String -> List(String)
*/
string-tokenize(|sepchars) =
string-tokenize({c: ?c; <fetch(?c)> sepchars})
/** @internal */
string-tokenize(sep) =
explode-string
; list-tokenize(sep)
; map(implode-string)
/**
* @inc tokenize-test1
* @inc tokenize-test2
* @inc tokenize-test3
* @inc tokenize-test4
* @inc tokenize-test5
*
* @type (List(Char), String) -> List(String)
*/
string-tokenize =
?(sepchars, <id>)
; string-tokenize(|sepchars)
strategies
/**
* @param s () -> Char
* @type String * Int -> String
* @inc padd-with-test
*/
padd-with(s) =
<align-right> (<s> (), <Fst>, <Snd>)
/**
* @type Char * String * Int -> String
*/
align-right :
(c, s, n) -> <conc-strings> (add, s)
where <align-helper(|c, n)> s => add
/**
* @type Char * String * Int -> String
*/
align-left :
(c, s, n) -> <conc-strings> (s, add)
where <align-helper(|c, n)> s => add
/**
* @type Char * String * Int -> String
*/
align-center :
(c, s, n) -> <concat-strings> [add-before, s, add-after]
where <string-length> s => l
; <subt> (n, l) => whitespace
; < even
< div2; Dupl
+ dec; div2; Dupl; (inc, id)
> whitespace => (before, after)
; <align-helper(|c, <add> (l, before))> s => add-before
; <align-helper(|c, <add> (l, after ))> s => add-after
/**
* @param c Char
* @param n Int
* @type String -> String
*/
align-helper(|c, n) =
string-length
; <subt> (n, <id>)
; if pos then
<copy-char> (<id>, c)
else
!""
end
div2 = <div> (<id>, 2)
rules
/** @internal */
SplitInit : x -> ([], [], x)
/** @internal */
SplitExit :
(xs, cs, []) ->
<reverse> [<reverse; implode-string> cs|xs]
/** @internal */
SplitNext :
(xs, cs, [32|ys]) ->
([<reverse; implode-string> cs | xs], [], ys)
/** @internal */
SplitNext :
(xs, cs, [y|ys]) -> (xs, [y|cs], ys)
where <not(eq)> (y, 32)
strategies
/**
* Splits a string at each occurrence of a whitespace. The
* resulting list of string does not contain any of the
* whitespaces. Two adjacent whitespaces will result in
* an empty string in the result.
*
* Example: <split-at-space> "foo bar" => ["foo", "", "bar"]
*
* @type String -> List(String)
*/
split-at-space =
explode-string;
SplitInit;
rec x(SplitExit <+ SplitNext; x)
/**
* @inc split-at-dot-test
*/
split-at-dot =
split(![],explode-string)
; rec r( \(int,[46|frac]) -> (int,frac)\
<+ \(int,[i|rest]) -> <r>(<at-end(![i])>int,rest)\
<+ (id,Nil))
; (implode-string,implode-string)
// fails if sub isn't in l
/**
* @inc split-before-test
*/
split-before = ?(l,sub);
<explode-string>sub => sub';
<explode-string>l;
\ x -> ([],x) \;
rec r( \ x@(_,x') -> x where <left-match>(x',sub') \ <+
\ (x',[x|xs]) -> <r>(<at-end(![x])>x',xs) \ );
(implode-string,implode-string)
// results in (l,"") if sub isn't in l
/**
* @inc split-after-test
*/
split-after = ?(l,sub);
<explode-string>sub => sub';
<explode-string>l;
\ x -> ([],x) \;
rec r( (id,[]) <+
\ (x,x') -> (<conc>(x,sub'),<left-match>(x',sub')) \ <+
\ (x',[x|xs]) -> <r>(<at-end(![x])>x',xs) \ );
(implode-string,implode-string)
/**
* Succeeds if the string produced by s is a substring
* of the argument string.
*
* @param _ -> String
* @type String -> _
*/
is-substring(s) =
explode-string;?long;
s;explode-string => sub;
(<eq>(sub,long)
<+
<rec r({a,xs:
?a@[_|xs]; (<left-match>(a,sub) <+ <r>xs)
})>long)
// <copy-char> (3, 32) -> " "
/**
* @inc copy-char-test
*/
copy-char =
copy; implode-string
/**
* Sorts a list of strings lexicographically, ignoring case, ascending.
*
* @inc string-sort-test-a
* @inc string-sort-test-b
* @inc string-sort-test-c
*
* @type List(String) -> List(String)
*/
string-sort =
map(explode-string)
; qsort(string-lt)
; map(implode-string)
/**
* Sorts a list of strings lexicographically ignoring case, descending.
*
* @type List(String) -> List(String)
*/
string-sort-desc =
map(explode-string)
; qsort(string-gt)
; map(implode-string)
strategies
/**
* Compares two strings or lists of characters lexicographically and succeeds if
* the first one is larger than the second, ignoring case.
*
* @type (List(Char), List(Char)) -> 1
* @type (String, String) -> 1
*/
string-gt =
try((explode-string, explode-string));
strcasecmp; ?1
/**
* Compares two strings or lists of characters lexicographically and succeeds if
* the first one is smaller than the second, ignoring case.
*
* @type (List(Char), List(Char)) -> 1
* @type (String, String) -> 1
*/
string-lt =
try((explode-string, explode-string));
strcasecmp; ?-1
/**
* Succeeds if the first String starts with the second String.
*
* If the strategy succeeds, the current term is left untouched.
*
* Example: <string-starts-with(|"foo")> "foobar"
*
* @type String -> String
*/
string-starts-with(|start) =
where(<left-match> (<explode-string>, <explode-string> start))
/**
* Succeeds if the first String ends with the second String.
*
* If the strategy succeeds, the current term is left untouched.
*
* Example: <string-ends-with(|"bar")> "foobar"
*
* @type String -> String
*/
string-ends-with(|end) =
where(<right-match> (<explode-string>, <explode-string> end))
/**
* Succeeds if the first list of terms starts with the second list of terms.
*
* Returns the suffix of the first list that is not matched.
*
* @type (List(a), List(a)) -> List(a)
*/
left-match =
rec r(
\ ([l|ls],[l|rs]) -> <r> (ls,rs) \
<+ (id,[])
)
; Fst
/**
* Succeeds if the first list of terms ends with the second list of terms.
*
* Returns the prefix of the first list that is not matched.
*
* @type (List(a), List(a)) -> List(a)
*/
right-match =
(reverse, reverse)
; left-match
; reverse
/**
* @inc strcmp
*/
strcmp = rec r(
\([x|xs],[x|ys]) -> <r>(xs,ys)\
<+ \([],[]) -> 0\
<+ \([x|_],[y|_]) -> -1 where <lt>(x,y)\
<+ \([],[_|_]) -> -1\
// these last two cases are handled faster by just !1
// <+ \([_|_],[]) -> 1\
// <+ \([x|_],[y|_]) -> 1\
<+ !1
)
/**
* Compares the n first characters of two character lists, n
* is given by the last argument. If the two lists are identical,
* the integer 0 is returned, otherwise the integer 1 is returned.
*
* @type List(Char) * List(Char) * Int -> Int
*/
strncmp = rec r
( \(_,_,0) -> 0\
<+ \([x|xs],[x|ys],i) -> <r>(xs,ys,<subt>(i,1))\
<+ \([],[],_) -> 0\
<+ \([x|_],[y|_],_) -> -1 where <lt>(x,y)\
<+ \([],[_|_],_) -> -1\
<+ !1
)
/**
* Compares two lists of characters lexicographically, ignoring case.
*
* Returns:
* -1 if first is smaller than the second.
* 0 if the strings are equal.
* 1 if the first is larger than the second.
*
* @type (List(Char), List(Char)) -> -1, 0,1 or -1.
*/
strcasecmp = rec r
( \([x|xs],[y|ys]) -> <r>(xs,ys) where <case-char(eq)>(x,y)\
<+ \([],[]) -> 0\
<+ \([x|_],[y|_]) -> -1 where <case-char(lt)>(x,y)\
<+ \([],[_|_]) -> -1\
<+ !1
)
strategies
/**
* Splits a string into a list of tokens, including the empty ones.
*
* This strategy differs from string-tokenize in that it produces an empty ""
* token when two separator chars are encountered, or after a final separator.
*
* Example:
* <string-tokenize-keep-empty(|['\n'])> "fu\n\nbar\n" => ["fu","","bar",""]
*
* @param The list of characters that may separate two tokens.
* @type sepChars [char]
* @type string -> [string]
* @since 0.9.5
*/
string-tokenize-keep-empty(|sepChars) =
explode-string
; rec x( ( split-fetch(<elem> (<id>, sepChars))
; \ (tchars, cs) -> [tchars|<x> cs] \ )
<+ ![<id>])
; map(implode-string)
/**
* Splits a string into a list of tokens, keeping the separating elements as
* 1-char-strings within the results list, *and* also keeping the empty
* "" tokens.
*
* Example:
* <string-tokenize-keep-all(|['\n'])> "fu\n\nbar\n" => ["fu","\n","","\n","bar","\n",""]
*
* @param The list of characters that may separate two tokens.
* @type sepChars [char]
* @type string -> [string]
* @since 0.9.5
*/
string-tokenize-keep-all(|sepChars) =
explode-string
; rec x( ( split-fetch-keep(where(<elem> (<id>, sepChars)))
; \ (tchars, s, cs) -> [tchars|[[s]|<x> cs]] \ )
<+ ![<id>])
; map(implode-string)
/**
* Gets all newline(\n, \r\n or \r)-separated lines in a string.
* If the string is ended by a newline, the last element of the returned list
* is the empty string.
*
* @type string -> [string]
* @since 0.9.4
*/
get-lines =
explode-string
; let split-at-newlines = {tl:
at-suffix(
(['\n' | tl] -> [])
<+ (['\r', '\n' | tl] -> [])
<+ (['\r' | tl] -> [])
)
; ![<id> | <split-at-newlines> tl]
<+ ![<id>]
}
in split-at-newlines
end
; map(implode-string)
/**
* Applies a strategy to all lines in a string.
*
* Lines are expected to be separated by a single '\n'.
* The last line may be ended by a newline, or not. In the former case, the
* last line in the resulting string will also be ended by a newline,
* otherwise not.
* Initial or intermediate newlines are preserved.
* The strategy is applied to each line (even the empty ones), *excluding*
* the newline character. The newline is appended again after application of s
*
* @param The strategy that should be applied to each line.
* @type s string -> string
* @type string -> string
* @since 0.9.4
*/
all-lines(s) =
is-string
; string-tokenize-keep-empty(|['\n'])
; at-last( \ [""] -> [] \ // Do not run s on a final empty line.
< where(!["\n"] => laststring) // ... but remember that the second last line was delimited by a newline
+ where(![] => laststring)) // ... or not.
; map(s)
; <separate-by> ("\n", <id>)
; <conc> (<id>, laststring) // Restore the final newline, if there was one.
; concat-strings
/**
* Makes one newline-separated string out of a list of strings.
*
* @since 0.9.4
*/
lines =
separate-by(!"\n")
; <conc> (<id>, ["\n"])
; concat-strings
/**
* Indents every line in a string with spaces.
*
* @param The number of spaces to be put in front of every line.
* @type n int
* @type string -> string
* @since 0.9.4
*/
indent-text(|n) =
where(<copy-char> (n, ' ') => prefix)
; prefix-lines(|prefix)
/**
* Prefixes all lines in a string with a string.
*
* @param The prefix.
* @type p string
* @type string -> string
* @since 0.9.4
*/
prefix-lines(|p) =
all-lines(<conc-strings> (p, <id>))
strategies
/**
* Trims leading characters from a string. The characters to
* to trim are given by the strategy argument.
*
* Removes from the left-hand side all characters matched by
* strategy s.
*
* Example: <ltrim-chars(?' ')> " fred " => "fred "
*
* @param should match all characters to be removed
* @type String -> String
* @since 0.9.5
*/
ltrim-chars(s) = string-as-chars(ltrim(s))
/**
* Trims trailing characters from a string.
*
* Removes from the right-hand side all characters matched by
* strategy s.
*
* Example: <rtrim-chars(?' ')> " fred " => " fred"
*
* @param should match on all characters to be removed
* @type String -> String
* @since 0.9.5
*/
rtrim-chars(s) = string-as-chars(rtrim(s))
/**
* Trims leading and trailing characters from a string. The
* characters to trim is given by the strategy argument.
*
* Removes from both ends all characters matched by strategy
* s.
*
* Example: <trim-chars(?' ')> " fred " => "fred"
*
* @param should match all characters to be removed
* @type String -> String
* @since 0.9.5
*/
trim-chars(s) = string-as-chars(trim(s))
/**
* Succeeds if the character is whitespace.
*
* Whitespace is a space (32), or a tab (9)
*
* @type Char -> Char
* @since 0.9.5
*/
is-whitespace = test('\t' + ' ')
/**
* Trims all trailing whitespace in a (single-line) string.
*
* @type String -> String
* @since 0.9.5
*/
trim-trailing-whitespace =
rtrim-chars(is-whitespace)
/**
* Trims all leading whitespace in a (single-line) string.
*
* @type String -> String
* @since 0.9.5
*/
trim-leading-whitespace =
ltrim-chars(is-whitespace)
/**
* Trims all trailing and leading whitespace in a (single-line) string.
*
* @type String -> String
* @since 0.9.5
*/
trim-whitespace =
trim-chars(is-whitespace)
strategies
/**
* Some shuffling strategies
* @internal
*/
shuffle-forced =
where(length; <gt> (<id>, 1))
; where(at-suffix(?[x,y|xs]; where(not(<eq> (x, y)))))
; rec x({orig: ?orig; shuffle; (where(<eq> (orig, <id>)) < x + id)})
<+ id
/** @internal */
shuffle =
where(is-list)
; map(!(<next-random> (), <id>))
; sort-list(SortL((Fst, Fst); gt))
; map(Snd)
/** @internal */
shuffle-word-mids =
string-tokenize-keep-all(|[' ', '.', ','])
; map(shuffle-word-mid)
; concat-strings
/** @internal */
shuffle-word-mid =
where(is-string)
; (where(strlen; <lt> (<id>, 3))
<+ explode-string
; ?[i|cs]
; <reverse> cs
; ?[l|mid]
; where(<shuffle-forced; reverse> mid => shuffledmid)
; <concat; implode-string> [[i],shuffledmid, [l]])
strategies
/**
* @inc is-alphanum-test
*/
is-alphanum = is-num + is-alpha
/**
* Succeeds if the character is part of the lowercase or
* uppercase alphabet.
*
* @type Char -> Char
*/
is-alpha = is-upper + is-lower
/**
* Succeeds if applied to a character that is a hexidecimal
* digit, i.e. either of the characters in the range '0'-'9'
* or 'A'-'F' or 'a'-'f'.
*
* @type Char -> Char
*/
is-hexnum =
is-char
; (
is-num
+ where(<leq-leq> ('a', <id>, 'f'))
+ where(<leq-leq> ('A', <id>, 'F'))
)
/**
* @inc is-num-test
* @inc is-not-num-test
*/
is-num =
where(<leq-leq> ('0', <id>, '9'))
/**
* Succeeds if this character is upper-case.
*
* @type Char -> Char
*/
is-upper =
where(<leq-leq> ('A', <id>, 'Z'))
/**
* Succeeds if this character is lower-case.
*
* @type Char -> Char
*/
is-lower =
where(<leq-leq> ('a', <id>, 'z'))
/**
* Succeeds if this string only contains printable ASCII characters.
*
* The letters 32 through 126, in total 96 characters, are defined
* as printable.
*
* @type Char -> Char
*/
is-ascii =
where(<leq-leq> ( 32, <id>, 127))
/**
* Applies a strategy to the upper-case variants of two characters.
*
* This is useful for doing case-insenstive operations.
*
* @param (Char, Char) -> a
* @type (Char, Char) -> a
*/
case-char(s) = (to-upper, to-upper); s
/**
* Ensures that a character is upper-case.
*
* This strategy returns the input character if this
* character is already upper-case.
*
* @type Char -> Char
*/
to-upper =
is-lower < <subt> (<id>, 32) + id
/**
* Ensures that a character is lower-case.
*
* This strategy returns the input character if this
* character is already lower-case.
*
* @type Char -> Char
*/
to-lower = is-upper < <add> (<id>, 32) + id
/**
* Replaces one substring with another in a string.
*
* Example: <string-replace(|"foo", "bar")> "foobarfoo" gives "barbarbar"
*
* @param old - the old substring which is to be excised
* @param new - the new subtring which is to be inserted
* @type String -> String
*
* @author Karl Trygve Kalleberg <karltk@stratego.org>
*/
string-replace(|old, new) =
!([], <explode-string>, <explode-string> old)
; internal-string-replace(|<explode-string> old, <explode-string ; reverse> new)
; reverse
; implode-string
strategies
/** @internal */
internal-string-replace(|old, new) =
?(pre, [ hd | tl ], cur)
; (
!cur => [hd | ctl]
; !(pre, tl, ctl)
; internal-string-replace-found(|old, new)
; internal-string-replace(|old, new)
<+
!([ hd | pre ], tl, cur)
; internal-string-replace(|old, new)
)
/** @internal */
internal-string-replace(|old, new):
(pre, [], _) -> pre
/** @internal */
internal-string-replace-found(|old, new) =
?(pre, [ hd | tl ], cur)
; !cur => [ hd | ctl ]
; !(pre, tl, ctl)
; internal-string-replace-found(|old, new)
/** @internal */
internal-string-replace-found(|old, new):
(pre, rest, []) -> (<conc> (new, pre), rest, old)