diff options
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.c | 35 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | tests/012/seq.tl | 56 | ||||
| -rw-r--r-- | txr.1 | 85 |
5 files changed, 173 insertions, 5 deletions
@@ -7830,6 +7830,7 @@ void eval_init(void) reg_fun(intern(lit("to"), user_package), func_n1(to)); reg_fun(intern(lit("in-range"), user_package), func_n2(in_range)); reg_fun(intern(lit("in-range*"), user_package), func_n2(in_range_star)); + reg_fun(intern(lit("rangeref"), user_package), func_n2(rangeref)); reg_fun(intern(lit("make-like"), user_package), func_n2(make_like)); reg_fun(intern(lit("nullify"), user_package), func_n1(nullify)); @@ -8537,7 +8537,7 @@ INLINE val do_generic_funcall(val fun, varg args_in) case 0: callerror(fun, lit("missing required arguments")); case 1: - return sub(args->arg[0], fun->rn.from, fun->rn.to); + return rangeref(fun, args->arg[0]); default: callerror(fun, lit("too many arguments")); } @@ -13288,6 +13288,8 @@ val ref(val seq, val ind) return vecref(seq, ind); case BUF: return buf_get_uchar(seq, ind); + case RNG: + return rangeref(seq, ind); default: type_mismatch(lit("ref: ~s is not a sequence"), seq, nao); } @@ -14039,6 +14041,37 @@ val in_range_star(val range, val num) } } +val rangeref(val range, val ind) +{ + val self = lit("rangeref"); + + if (integerp(ind)) + { + val fr = range->rn.from; + val to = range->rn.to; + val eind = ind; + + if (to != t && to != colon_k) { + val len = minus(to, fr); + + if (minusp(eind)) + eind = plus(eind, len); + + if (minusp(eind) || ge(eind, len)) + goto err; + } else if (minusp(eind)) { + goto err; + } + + return plus(fr, eind); + err: + uw_throwf(error_s, lit("~a: ~s is out of range for ~s"), + self, ind, range, nao); + } + + return sub(ind, range->rn.from, range->rn.to); +} + #if CONFIG_LOCALE_TOLERANCE static void locale_init(void) @@ -1442,6 +1442,7 @@ val set_from(val range, val from); val set_to(val range, val to); val in_range(val range, val num); val in_range_star(val range, val num); +val rangeref(val range, val ind); void out_str_char(wchar_t ch, val out, int *semi_flag, int regex); val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *); val obj_print(val obj, val stream, val pretty); diff --git a/tests/012/seq.tl b/tests/012/seq.tl index 21200268..c48296bd 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -825,3 +825,59 @@ (vtest [apply mapcar join (list-seq "aaa".."zzz")] (transpose (list-seq "aaa".."zzz"))) + +(mtest + (ref "a".."z" 0) :error + (ref (rcons 'foo 'bar)) :error) + +(mtest + (ref 1..6 0) 1 + (ref 1..6 1) 2 + (ref 1..6 4) 5 + (ref 1..6 5) :error + (ref 1..6 -1) 5 + (ref 1..6 -2) 4 + (ref 1..6 -5) 1 + (ref 1..6 -6) :error) + +(mtest + (ref 1..: 0) 1 + (ref 1..: 1) 2 + (ref 1..: 4) 5 + (ref 1..: -1) :error + (ref 1..: -2) :error) + +(mtest + (ref 1..t 0) 1 + (ref 1..t 1) 2 + (ref 1..t 4) 5 + (ref 1..t -1) :error + (ref 1..: -2) :error) + +(mtest + (ref #\a..#\f 0) #\a + (ref #\a..#\f 1) #\b + (ref #\a..#\f 4) #\e + (ref #\a..#\f 5) :error + (ref #\a..#\f -1) #\e + (ref #\a..#\f -2) #\d + (ref #\a..#\f -5) #\a + (ref #\a..#\f -6) :error) + +(mtest + (ref #\a..: 0) #\a + (ref #\a..: 1) #\b + (ref #\a..: 4) #\e + (ref #\a..: -1) :error + (ref #\a..: -2) :error) + +(mtest + (ref #\a..t 0) #\a + (ref #\a..t 1) #\b + (ref #\a..t 4) #\e + (ref #\a..t -1) :error + (ref #\a..: -2) :error) + + +(mtest + (ref 1..6 0.0) (1.0 2.0 3.0 4.0 5.0)) @@ -16411,10 +16411,17 @@ The value acts as the index into a vector-like or list-like sequence, or a key into a hash table. -.meIP >> [ range << sequence ] -If the left argument is a range, it denotes selection of a -subrange of -.metn sequence . +.meIP >> [ range >> { seq | << ind }] +If the left argument is a range, and there is one argument, the +semantics is that of the +.code rangeref +function: either the selection of a point from the range by +an integer index +.metn ind , +or the selection of a subrange of sequence +.meta seq +according to the endpoints of +.metn range . .RE .PP @@ -25797,6 +25804,69 @@ The following equivalences hold: (in-range* r x) <--> (and (lequal (from r) x) (less x (to r))) .brev + +.coNP Function @ rangeref +.synb +.mets (rangeref < range >> [ idx | << seq ]) +.syne +.desc +The +.code rangeref +function requires its +.meta range +argument to be a range object. + +It supports two semantics, based on the type of the second argument. + +If the second argument is an integer, then it is interpreted as +.metn idx . +The function then treats the +.meta range +as if it were a sequence. The +.meta range +must be a numeric or character range. +The +.code from +field of +.meta range +is added to +.meta idx +to form the tentative return value. + +If the +.code to +field is a value other than +.code t +or the +.code : +(colon) symbol, then the tentative value must be less than +the value of this field, or an exception is thrown. +In other words, +.meta ind +must indicate a point within the range. + +After the above range check is performed, if applicable, +the tentative value is returned. + +If the second argument isn't an integer, it is interpreted +as a sequence +.metn seq . +The +.meta range +object's values are used to extract a subrange of +.metn seq , +according to the following equivalence: + +.verb + (rangeref r s) <--> (sub s (from r) (to r)) +.brev + +except that +.code r +and +.code s +are evaluated only once, in that order. + .SS* Characters and Strings .coNP Functions @ mkstring and @ str .synb @@ -35511,6 +35581,13 @@ is a search tree, then behaves like .codn tree-lookup . +If +.meta sequence +is a range object, then +.code ref +behaves like +.codn rangeref . + A .code ref expression may be used as a place. Storing a value into a |