# SPDX-License-Identifier: BSD-2-Clause
function _eval3_string(form, env, d, car, a) {
car = _car(form)
if(car == _symbol("tolower"))
return _tolower(_eval3(_cadr(form), env, env, d+1))
else if(car == _symbol("toupper"))
return _toupper(_eval3(_cadr(form), env, env, d+1))
else if(car == _symbol("substr"))
# trusting the user here to provide either two or three args
if(_is_null(_cdddr(form)))
return _substr2(_eval3(_cadr(form), env, env, d+1),
_eval3(_caddr(form), env, env, d+1))
else
return _substr3(_eval3(_cadr(form), env, env, d+1),
_eval3(_caddr(form), env, env, d+1),
_eval3(_car(_cdddr(form)), env, env, d+1))
else if(car == _symbol("index"))
return _index(_eval3(_cadr(form), env, env, d+1),
_eval3(_caddr(form), env, env, d+1))
else if(car == _symbol("match"))
return _match(_eval3(_cadr(form), env, env, d+1),
_eval3(_caddr(form), env, env, d+1))
else if(car == _symbol("split"))
# for now you must provide fs
return _split2(_eval3(_cadr(form), env, env, d+1),
_eval3(_caddr(form), env, env, d+1))
# it would be easy to make non-destructive sub and gsub.
else if(car == _symbol("sub"))
# for now you must provide s
return _sub3(_eval3(_cadr(form), env, env, d+1),
_eval3(_caddr(form), env, env, d+1),
_eval3(_car(_cdddr(form)), env, env, d+1))
else if(car == _symbol("gsub"))
return _gsub3(_eval3(_cadr(form), env, env, d+1),
_eval3(_caddr(form), env, env, d+1),
_eval3(_car(_cdddr(form)), env, env, d+1))
else if(car == _symbol("sprintf"))
# same
return _sprintf(_eval3(_cadr(form), env, env, d+1),
_cddr(form), env, d+1)
else if(car == _symbol("string-length"))
return _string_length(_eval3(_cadr(form), env, env, d+1))
else if(car == _symbol("strcat"))
# same, varargs.
return _strcat(_cdr(form), env, d+1)
else if(car == _symbol("shellquote"))
return _shellquote(_eval3(_cadr(form), env, env, d+1))
else _builtin_mischaracterization("_eval3_string", car)
}
function _shellquote(s, subber) {
if(_TYPE[s] == "s") {
subber = _STRING[s]
# This lisp is aimed at system administration, where it might
# run as root, and unquoted control characters output to a
# terminal may have ill effects. Rather nerf the control
# characters than pass them through. But we'll let \011, HT;
# \012, LF; and \015, CR, through.
gsub(/[\001-\010\013-\014\016-\037\177]/,
"[GlotawkNerfedCtrl]", subber)
gsub(/'/, "'\\''", subber)
sub(/^/, "'", subber)
sub(/$/, "'", subber)
return _string(subber)
} else {
logg_err("_shellquote", "non-string operand " _repr(s))
return _nil()
}
}
function _tolower(s, tv) {
if(_TYPE[s] == "s") {
return _string(tolower(_STRING[s]))
} else {
logg_err("_tolower", "non-string operand " _repr(s))
return _nil()
}
}
function _toupper(s, tv) {
if(_TYPE[s] == "s") {
return _string(toupper(_STRING[s]))
} else {
logg_err("_toupper", "non-string operand " _repr(s))
return _nil()
}
}
function _substr2(s, a, tv) {
if(_TYPE[s] == "s") {
split(a, tv)
if(tv[1] == "#") {
return _string(substr(_STRING[s], tv[2]))
} else {
logg_err("_substr2", "non-numeric a " _repr(a))
return _nil()
}
} else {
logg_err("_substr2", "non-string s " _repr(s))
return _nil()
}
}
function _substr3(s, a, b, tv) {
if(_TYPE[s] == "s") {
split(a, tv)
if(tv[1] == "#") {
a = tv[2]
split(b, tv)
if(tv[1] == "#") {
b = tv[2]
return _string(substr(_STRING[s], a, b))
} else {
logg_err("_substr3", "non-numeric b " _repr(b))
return _nil()
}
} else {
logg_err("_substr3", "non-numeric a " _repr(a))
return _nil()
}
} else {
logg_err("_substr3", "non-string s " _repr(s))
return _nil()
}
}
function _index(s, t) {
if(_TYPE[s] == "s") {
if(_TYPE[t] == "s") {
return _number(index(_STRING[s], _STRING[t]))
} else {
logg_err("_index", "non-string t " _repr(t))
return _nil()
}
} else {
logg_err("_index", "non-string s " _repr(s))
return _nil()
}
}
function _match(s, r) {
if(_TYPE[s] == "s") {
if(_TYPE[r] == "s") {
match(_STRING[s], _STRING[r])
# if no match, RSTART will be 0 and RLENGTH -1. let's
# return something falsy in that case
if(RSTART == 0 && RLENGTH == -1)
return _nil()
else
return _cons(_number(RSTART),
_cons(_number(RLENGTH), _nil()))
} else {
logg_err("_match", "non-string r " _repr(r))
return _nil()
}
} else {
logg_err("_match", "non-string s " _repr(s))
return _nil()
}
}
function _split2(s, fs, a) {
if(_TYPE[s] == "s") {
if(_TYPE[fs] == "s") {
split(_STRING[s], a, _STRING[fs])
return _awk_array_of_strings_to_list(a)
} else {
logg_err("_split", "non-string fs " _repr(fs))
}
} else {
logg_err("_split", "non-string s " _repr(s))
return _nil()
}
}
function _string_length(s, tv) {
if(_TYPE[s] == "s") {
return _number(length(_STRING[s]))
} else {
logg_err("_string_length", "non-string " _repr(s))
return _nil()
}
}
function _strcat(unevald, env, d, s, here, val) {
s = ""
for(here=unevald; !_is_null(here); here=_cdr(here)) {
val = _eval3(_car(here), env, env, d+1)
if(_TYPE[val] == "s") {
s = s _STRING[val]
} else {
logg_err("_strcat", "non-string param " _repr(val))
return _nil()
}
}
return _string(s)
}
function _sub3(r, t, s, new_s, rv) {
if(_TYPE[r] == "s") {
if(_TYPE[t] == "s") {
if(_TYPE[s] == "s") {
new_s = _STRING[s]
sub(_STRING[r], _STRING[t], new_s)
return _string(new_s)
} else {
logg_err("_sub3", "non-string s " _repr(s))
return _nil()
}
} else {
logg_err("_sub3", "non-string t " _repr(t))
return _nil()
}
} else {
logg_err("_sub3", "non-string r " _repr(r))
return _nil()
}
}
function _gsub3(r, t, s, new_s, rv) {
if(_TYPE[r] == "s") {
if(_TYPE[t] == "s") {
if(_TYPE[s] == "s") {
# whoa nelly, destructive update.
new_s = _STRING[s]
gsub(_STRING[r], _STRING[t], new_s)
return _string(new_s)
} else {
logg_err("_gsub3", "non-string s " _repr(s))
return _nil()
}
} else {
logg_err("_gsub3", "non-string t " _repr(t))
return _nil()
}
} else {
logg_err("_gsub3", "non-string r " _repr(r))
return _nil()
}
}
function _sprintf(fmt, unevald, env, d, dlave, evald, s, a, i, p) {
n = 1
dlave = _nil()
# even if there are extra arguments, they should all be evaluated
for(; !_is_null(unevald); unevald=_cdr(unevald)) {
dlave = _cons(_eval3(_car(unevald), env, env, d+1), dlave)
}
evald = _nreverse(dlave)
_list_to_flat_awk_array_of_any(evald, a)
i = 1
s = ""
fmt = _STRING[fmt]
# here we fill in just one format specifier at a time, because awk
# has no splatting: we can't say a[1] = 5; a[2] = 7;
# sprintf("%d%d", *a). so there is no way to produce a variadic
# call to sprintf. to be less simple and perhaps faster, we might
# count format specifiers (skipping %%'s!) and do special cases
# for 1 to 5 parameters; but this while loop should cover all
# cases.
while(fmt != "") {
# logg_dbg("_sprintf", " fmt is " fmt " and s is " s)
# find a format specification
if(match(fmt, /%/)) {
# just copy whatever is before the %
s = s substr(fmt, 1, RSTART-1)
fmt = substr(fmt, RSTART)
# logg_dbg("_sprintf", "now fmt is " fmt " and s is " s)
if(match(fmt, /^%%/)) {
# this is just an escaped %. don't eat a parameter.
s = s "%"
fmt = substr(fmt, 3)
continue
}
# now the %-thing is at the beginning of fmt. how long is
# it? (grammar derived from FreeBSD printf(3); your libc
# may vary)
match(fmt,/^%[*#+ 0-9.'-]*[diouxXfFeEgGaAcsb]/);
# RLENGTH is the length of the format specifier.
if(i > length(a)) {
logg_err("_sprintf", "not enough values for sprintf!")
p = _nil()
} else {
p = a[i++]
}
# logg_dbg("_sprintf", "tiny fmt is " substr(fmt,1,RLENGTH))
s = s sprintf(substr(fmt,1,RLENGTH), p)
fmt = substr(fmt, RLENGTH+1)
} else {
s = s fmt
fmt = ""
}
}
return _string(s)
}