diff options
| -rw-r--r-- | ChangeLog | 20 | ||||
| -rw-r--r-- | arith.c | 4 | ||||
| -rw-r--r-- | eval.c | 61 | ||||
| -rw-r--r-- | lib.c | 75 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | txr.1 | 33 | ||||
| -rw-r--r-- | txr.vim | 2 |
7 files changed, 168 insertions, 28 deletions
@@ -1,5 +1,25 @@ 2012-01-26 Kaz Kylheku <kaz@kylheku.com> + * arith.c (plus, minus): Better wording in error messages. + + * eval.c (dwim_loc): Assignments to string indices and ranges + supported. New arguments for this purpose. + (op_modplace): Use new dwim_loc interface for returned value. + (op_dwim): Support assignment to string ranges. + (eval_init): replace_str registered. + + * lib.c (string_extend): If the argument is a number, let it + specify the amount by which to extend the string. + (replace_str): New function. + + * lib.h (replace_str): Declared. + + * txr.1: Updated. + + * txr.vim: Updated. + +2012-01-26 Kaz Kylheku <kaz@kylheku.com> + * lib.c (listref, listref_l): Negative indices must have semantics consistent with vecref and ranges. @@ -348,7 +348,7 @@ val plus(val anum, val bnum) uw_throwf(error_s, lit("plus: invalid operands ~s ~s"), anum, bnum, nao); char_range: uw_throwf(numeric_error_s, - lit("plus: sum of ~s ~s is out of character range"), + lit("plus: sum of ~s and ~s is out of character range"), anum, bnum, nao); } @@ -429,7 +429,7 @@ val minus(val anum, val bnum) if (sum < 0 || sum > 0x10FFFF) uw_throwf(numeric_error_s, - lit("minus: sum of ~s ~s is out of character range"), + lit("minus: difference of ~s and ~s is out of character range"), anum, bnum, nao); return chr(sum); } @@ -637,7 +637,7 @@ static val op_defun(val form, val env) return name; } -static val *dwim_loc(val form, val env, val op, val newval) +static val *dwim_loc(val form, val env, val op, val newval, val *retval) { val obj = eval(second(form), env, form); val args = eval_args(rest(rest(form)), env, form); @@ -649,8 +649,38 @@ static val *dwim_loc(val form, val env, val op, val newval) case LIT: case STR: case LSTR: - eval_error(form, lit("[~s ...]: string element assignment not implemented!"), - obj, nao); + if (rest(args)) + eval_error(form, lit("[~s ...]: string indexing needs one arg"), + obj, nao); + { + val index = first(args); + + if (consp(index)) { + if (op != set_s) + eval_error(form, lit("[~s ~s]: ranges takes only set assignments"), + obj, index, nao); + + replace_str(obj, car(index), cdr(index), newval); + *retval = newval; + return 0; + } else { + uses_or2; + if (op == set_s) { + chr_str_set(obj, index, newval); + } else if (op == inc_s) { + newval = plus(chr_str(obj, index), or2(newval, one)); + chr_str_set(obj, index, newval); + } else if (op == dec_s) { + newval = minus(chr_str(obj, index), or2(newval, one)); + chr_str_set(obj, index, newval); + } else { + eval_error(form, lit("[~s ~s]: only set, inc and dec can be used " + "for string indices"), obj, index, nao); + } + *retval = newval; + return 0; + } + } case SYM: case FUN: eval_error(form, lit("[~s ...]: assigning through function not implemented!"), @@ -664,10 +694,11 @@ static val *dwim_loc(val form, val env, val op, val newval) if (consp(index)) { if (op != set_s) - eval_error(form, lit("[~s ~s]: slice takes only simple assignments"), + eval_error(form, lit("[~s ~s]: ranges take only set assignments"), obj, index, nao); replace_vec(obj, car(index), cdr(index), newval); + *retval = newval; return 0; } else { return vecref_l(obj, first(args)); @@ -688,13 +719,14 @@ static val *dwim_loc(val form, val env, val op, val newval) val tempform; if (op != set_s) - eval_error(form, lit("[~s ~s]: slice takes only simple assignments"), + eval_error(form, lit("[~s ~s]: ranges take only simple assignments"), cell, index, nao); newlist = replace_list(obj, car(index), cdr(index), newval); tempform = list(op, second(form), cons(quote_s, cons(newlist, nil)), nao); eval(tempform, env, form); + *retval = newval; return 0; } else { eval_error(form, lit("[~s ~s]: index must be integer, or pair"), @@ -750,9 +782,10 @@ static val op_modplace(val form, val env) /* TODO: dispatch these with hash table. */ val sym = car(place); if (sym == dwim_s) { - loc = dwim_loc(place, env, op, newval); + val ret; + loc = dwim_loc(place, env, op, newval, &ret); if (loc == 0) - return newval; + return ret; } else if (sym == gethash_s) { val hash = eval(second(place), env, form); val key = eval(third(place), env, form); @@ -786,10 +819,10 @@ static val op_modplace(val form, val env) eval_error(form, lit("~a: missing argument"), op, place, nao); return *loc = newval; } else if (op == inc_s) { - val inc = or2(newval, num(1)); + val inc = or2(newval, one); return *loc = plus(*loc, inc); } else if (op == dec_s) { - val inc = or2(newval, num(1)); + val inc = or2(newval, one); return *loc = minus(*loc, inc); } else if (op == push_s) { return push(newval, loc); @@ -916,7 +949,14 @@ static val op_dwim(val form, val env) if (rest(args)) eval_error(form, lit("[~s ...]: string indexing needs one arg"), obj, nao); - return chr_str(obj, first(args)); + { + val index = first(args); + if (consp(index)) { + return sub_str(obj, car(index), cdr(index)); + } else { + return chr_str(obj, first(args)); + } + } case SYM: { val fbinding = lookup_fun(env, obj); @@ -1858,6 +1898,7 @@ void eval_init(void) reg_fun(intern(lit("search-str"), user_package), func_n4(search_str)); reg_fun(intern(lit("search-str-tree"), user_package), func_n4(search_str_tree)); reg_fun(intern(lit("sub-str"), user_package), func_n3(sub_str)); + reg_fun(intern(lit("replace-str"), user_package), func_n4(replace_str)); reg_fun(intern(lit("cat-str"), user_package), func_n2(cat_str)); reg_fun(intern(lit("split-str"), user_package), func_n2(split_str)); reg_fun(intern(lit("split-str-set"), user_package), func_n2(split_str_set)); @@ -1296,6 +1296,8 @@ val string_extend(val str, val tail) needed = length_str(tail); else if (chrp(tail)) needed = one; + else if (fixnump(tail)) + needed = tail; else uw_throwf(error_s, lit("string_extend: tail ~s bad type"), str, nao); @@ -1320,7 +1322,7 @@ val string_extend(val str, val tail) if (stringp(tail)) { wmemcpy(str->st.str + len, c_str(tail), c_num(needed) + 1); - } else { + } else if (chrp(tail)) { str->st.str[len] = c_chr(tail); str->st.str[len + 1] = 0; } @@ -1482,6 +1484,77 @@ val sub_str(val str_in, val from, val to) } } +val replace_str(val str_in, val from, val to, val items) +{ + val len = length_str(str_in); + val len_it = length(items); + val len_rep; + + if (type(str_in) != STR) + uw_throwf(error_s, lit("replace_str: string ~s of type ~s not supported"), + str_in, typeof(str_in), nao); + + if (from == nil) + from = zero; + else if (from == t) + from = len; + else if (lt(from, zero)) + from = plus(from, len); + + if (to == nil || to == t) + to = len; + else if (lt(to, zero)) + to = plus(to, len); + + from = max2(zero, min2(from, len)); + to = max2(zero, min2(to, len)); + + len_rep = minus(to, from); + + if (gt(len_rep, len_it)) { + val len_diff = minus(len_rep, len_it); + cnum t = c_num(to); + cnum l = c_num(len); + + wmemmove(str_in->st.str + t - c_num(len_diff), + str_in->st.str + t, (l - t) + 1); + str_in->st.len = minus(len, len_diff); + to = plus(from, len_it); + } else if (lt(len_rep, len_it)) { + val len_diff = minus(len_it, len_rep); + cnum t = c_num(to); + cnum l = c_num(len); + + string_extend(str_in, plus(len, len_diff)); + wmemmove(str_in->st.str + t + c_num(len_diff), + str_in->st.str + t, (l - t) + 1); + to = plus(from, len_it); + } + + if (zerop(len_it)) + return str_in; + if (stringp(items)) { + wmemcpy(str_in->st.str + c_num(from), c_str(items), c_num(len_it)); + } else { + val iter; + cnum f = c_num(from); + cnum t = c_num(to); + + if (listp(items)) { + for (iter = items; iter && f != t; iter = cdr(iter), f++) + str_in->st.str[f] = c_chr(car(iter)); + } else if (vectorp(items)) { + for (; f != t; f++) + str_in->st.str[f] = c_chr(vecref(items, num(f))); + } else { + uw_throwf(error_s, lit("replace_str: source object ~s not supported"), + items, nao); + } + } + return str_in; +} + + val cat_str(val list, val sep) { cnum total = 0; @@ -420,6 +420,7 @@ val length_str(val str); const wchar_t *c_str(val str); val search_str(val haystack, val needle, val start_num, val from_end); val search_str_tree(val haystack, val tree, val start_num, val from_end); +val replace_str(val str_in, val from, val to, val items); val sub_str(val str_in, val from_num, val to_num); val cat_str(val list, val sep); val split_str(val str, val sep); @@ -4839,8 +4839,8 @@ determine the initial value of the place. Otherwise it is ignored. The vecref place denotes a vector element, allowing vector elements to be treated as assignment places. -The dwim/[] place denotes a vector element, list element, or hash table, -depending on the type of obj. +The dwim/[] place denotes a vector element, list element, string, or hash +table, depending on the type of obj. .SS Operator dwim @@ -4903,29 +4903,32 @@ See the section on Range Indexing below. Retrieve the specified element of a string. This is equivalent to (chr-str <string> <index>). +.IP [<string> <from-index>..<to-below-index>] +Retrieve the specified range of characters from the string, exactly as if +using (sub-str <string> <from-index> <to-below-index>). +The range of elements is specified in the car and cdr fields of a cons cell, +for which the .. (dotdot) syntactic sugar is useful. +See the section on Indexing below. + .IP [<hash-table> <key> <default-value>] Retrieve a value from the hash table corresponding to <key>, or <default-value> if there is no such entry. -The list, vector and hash table forms of dwim denote places -that can be assigned. - -The list and vector range forms can be assigned only using the set operator, -not using the others like push and inc. Assigning to a vector range modifies -the vector object; it is implemented using replace-vec. Assigning to a list -range updates the form which contains the list, so the expression denoting the -list must be an assignable place. +The places denoted by the dwim operator can be assigned. There are some +restrictions. List, string and vector ranges can only be replaced with set. The +other operators like push do not apply. Characters in a string can only be +assigned with set or incremented with inc and dec. .TP Range Indexing -Array and list range indexing is based from zero. The first element element -zero. Furthermore, the value -1 refers to the last element of the array or +Vector and list range indexing is based from zero. The first element element +zero. Furthermore, the value -1 refers to the last element of the vector or list, and -2 to the second last and so forth. So the range 1 .. -2 means "everything except for the first element and the last two". -The symbol t represents the position one past the end of the array or -list, so 0 .. t denotes the entire list or array, and the range t .. t +The symbol t represents the position one past the end of the vector, string or +list, so 0 .. t denotes the entire list or vector, and the range t .. t represents the empty range just beyond the last element. It is possible to assign to t .. t. For instance: @@ -6317,6 +6320,8 @@ Certain object types have a custom equal function. .SS Function sub-str +.SS Function replace-str + .SS Function cat-str .SS Function split-str @@ -60,7 +60,7 @@ syn keyword txl_keyword contained make-sym gensym *gensym-counter* make-package syn keyword txl_keyword contained intern symbolp symbol-name symbol-package keywordp syn keyword txl_keyword contained mkstring copy-str upcase-str downcase-str string-extend syn keyword txl_keyword contained stringp lazy-stringp length-str search-str search-str-tree -syn keyword txl_keyword contained sub-str cat-str split-str +syn keyword txl_keyword contained sub-str cat-str split-str replace-str syn keyword txl_keyword contained split-str-set list-str trim-str syn keyword txl_keyword contained string-lt int-str chrp chr-isalnum chr-isalpha syn keyword txl_keyword contained chr-isascii chr-iscntrl chr-isdigit chr-isgraph |