diff options
| -rw-r--r-- | eval.c | 15 | ||||
| -rw-r--r-- | lib.c | 268 | ||||
| -rw-r--r-- | lib.h | 13 | ||||
| -rw-r--r-- | txr.1 | 80 |
4 files changed, 373 insertions, 3 deletions
@@ -4771,8 +4771,13 @@ void eval_init(void) reg_fun(memq_s, func_n2(memq)); reg_fun(memql_s, func_n2(memql)); reg_fun(memqual_s, func_n2(memqual)); + reg_fun(intern(lit("rmemq"), user_package), func_n2(rmemq)); + reg_fun(intern(lit("rmemql"), user_package), func_n2(rmemql)); + reg_fun(intern(lit("rmemqual"), user_package), func_n2(rmemqual)); reg_fun(intern(lit("member"), user_package), func_n4o(member, 2)); + reg_fun(intern(lit("rmember"), user_package), func_n4o(rmember, 2)); reg_fun(intern(lit("member-if"), user_package), func_n3o(member_if, 2)); + reg_fun(intern(lit("rmember-if"), user_package), func_n3o(rmember_if, 2)); reg_fun(intern(lit("remq"), user_package), func_n2(remq)); reg_fun(intern(lit("remql"), user_package), func_n2(remql)); reg_fun(intern(lit("remqual"), user_package), func_n2(remqual)); @@ -4789,10 +4794,15 @@ void eval_init(void) reg_fun(intern(lit("countq"), user_package), func_n2(countq)); reg_fun(intern(lit("count-if"), user_package), func_n3o(count_if, 2)); reg_fun(intern(lit("posqual"), user_package), func_n2(posqual)); + reg_fun(intern(lit("rposqual"), user_package), func_n2(rposqual)); reg_fun(intern(lit("posql"), user_package), func_n2(posql)); + reg_fun(intern(lit("rposql"), user_package), func_n2(rposql)); reg_fun(intern(lit("posq"), user_package), func_n2(posq)); + reg_fun(intern(lit("rposq"), user_package), func_n2(rposq)); reg_fun(intern(lit("pos"), user_package), func_n4o(pos, 2)); + reg_fun(intern(lit("rpos"), user_package), func_n4o(rpos, 2)); reg_fun(intern(lit("pos-if"), user_package), func_n3o(pos_if, 2)); + reg_fun(intern(lit("rpos-if"), user_package), func_n3o(rpos_if, 2)); reg_fun(intern(lit("some"), user_package), func_n3o(some_satisfy, 1)); reg_fun(intern(lit("all"), user_package), func_n3o(all_satisfy, 1)); reg_fun(intern(lit("none"), user_package), func_n3o(none_satisfy, 1)); @@ -5137,10 +5147,12 @@ void eval_init(void) reg_fun(intern(lit("sort"), user_package), func_n3o(sort, 1)); reg_fun(intern(lit("shuffle"), user_package), func_n1(shuffle)); reg_fun(intern(lit("find"), user_package), func_n4o(find, 2)); - reg_fun(intern(lit("multi-sort"), user_package), func_n3o(multi_sort, 2)); + reg_fun(intern(lit("rfind"), user_package), func_n4o(rfind, 2)); reg_fun(intern(lit("find-if"), user_package), func_n3o(find_if, 2)); + reg_fun(intern(lit("rfind-if"), user_package), func_n3o(rfind_if, 2)); reg_fun(intern(lit("find-max"), user_package), func_n3o(find_max, 1)); reg_fun(intern(lit("find-min"), user_package), func_n3o(find_min, 1)); + reg_fun(intern(lit("multi-sort"), user_package), func_n3o(multi_sort, 2)); reg_fun(intern(lit("set-diff"), user_package), func_n4o(set_diff, 2)); reg_fun(intern(lit("seqp"), user_package), func_n1(seqp)); @@ -5155,6 +5167,7 @@ void eval_init(void) reg_fun(intern(lit("dwim-del"), system_package), func_n2(dwim_del)); reg_fun(intern(lit("update"), user_package), func_n2(update)); reg_fun(intern(lit("search"), user_package), func_n4o(search, 2)); + reg_fun(intern(lit("rsearch"), user_package), func_n4o(rsearch, 2)); reg_fun(intern(lit("where"), user_package), func_n2(where)); reg_fun(intern(lit("select"), user_package), func_n2(sel)); @@ -1303,6 +1303,17 @@ val memq(val obj, val list) return make_like(list, list_orig); } +val rmemq(val obj, val list) +{ + val list_orig = list; + val found = nil; + list = nullify(list); + gc_hint(list); + while (list && (found = (car(list) != obj ? list : found))) + list = cdr(list); + return make_like(found, list_orig); +} + val memql(val obj, val list) { val list_orig = list; @@ -1313,6 +1324,17 @@ val memql(val obj, val list) return make_like(list, list_orig); } +val rmemql(val obj, val list) +{ + val list_orig = list; + val found = nil; + list = nullify(list); + gc_hint(list); + while (list && (found = (eql(car(list), obj) ? list : found))) + list = cdr(list); + return make_like(found, list_orig); +} + val memqual(val obj, val list) { val list_orig = list; @@ -1323,6 +1345,17 @@ val memqual(val obj, val list) return make_like(list, list_orig); } +val rmemqual(val obj, val list) +{ + val list_orig = list; + val found = nil; + list = nullify(list); + gc_hint(list); + while (list && (found = (equal(car(list), obj) ? list : found))) + list = cdr(list); + return make_like(found, list_orig); +} + val member(val item, val list, val testfun, val keyfun) { testfun = default_arg(testfun, equal_f); @@ -1343,6 +1376,27 @@ val member(val item, val list, val testfun, val keyfun) return nil; } +val rmember(val item, val list, val testfun, val keyfun) +{ + val found = nil; + testfun = default_arg(testfun, equal_f); + keyfun = default_arg(keyfun, identity_f); + + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list)) { + val elem = car(list); + val key = funcall1(keyfun, elem); + + if (funcall2(testfun, item, key)) + found = list; + } + + return found; +} + val member_if(val pred, val list, val key) { key = default_arg(key, identity_f); @@ -1361,6 +1415,24 @@ val member_if(val pred, val list, val key) return nil; } +val rmember_if(val pred, val list, val key) +{ + val found = nil; + key = default_arg(key, identity_f); + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list)) { + val item = car(list); + val subj = funcall1(key, item); + + if (funcall1(pred, subj)) + found = list; + } + + return found; +} val remq(val obj, val list) { @@ -7253,6 +7325,27 @@ val find(val item, val list, val testfun, val keyfun) return nil; } +val rfind(val item, val list, val testfun, val keyfun) +{ + val found = nil; + testfun = default_arg(testfun, equal_f); + keyfun = default_arg(keyfun, identity_f); + + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list)) { + val elem = car(list); + val key = funcall1(keyfun, elem); + + if (funcall2(testfun, item, key)) + found = elem; + } + + return found; +} + val find_max(val seq, val testfun, val keyfun) { val maxkey; @@ -7306,6 +7399,25 @@ val find_if(val pred, val list, val key) return nil; } +val rfind_if(val pred, val list, val key) +{ + val found = nil; + key = default_arg(key, identity_f); + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list)) { + val item = car(list); + val subj = funcall1(key, item); + + if (funcall1(pred, subj)) + found = item; + } + + return found; +} + val posqual(val obj, val list) { val pos = zero; @@ -7321,6 +7433,22 @@ val posqual(val obj, val list) return nil; } +val rposqual(val obj, val list) +{ + val pos = zero; + val found = nil; + + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list), pos = plus(pos, one)) + if (equal(car(list), obj)) + found = pos; + + return found; +} + val posql(val obj, val list) { val pos = zero; @@ -7336,6 +7464,22 @@ val posql(val obj, val list) return nil; } +val rposql(val obj, val list) +{ + val pos = zero; + val found = nil; + + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list), pos = plus(pos, one)) + if (eql(car(list), obj)) + pos = found; + + return pos; +} + val posq(val obj, val list) { val pos = zero; @@ -7351,6 +7495,22 @@ val posq(val obj, val list) return nil; } +val rposq(val obj, val list) +{ + val pos = zero; + val found = nil; + + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list), pos = plus(pos, one)) + if (car(list) == obj) + found = pos; + + return found; +} + val pos(val item, val list, val testfun, val keyfun) { val pos = zero; @@ -7371,6 +7531,26 @@ val pos(val item, val list, val testfun, val keyfun) return nil; } +val rpos(val item, val list, val testfun, val keyfun) +{ + val pos = zero; + val found = nil; + testfun = default_arg(testfun, equal_f); + keyfun = default_arg(keyfun, identity_f); + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list), pos = plus(pos, one)) { + val elem = car(list); + val key = funcall1(keyfun, elem); + + if (funcall2(testfun, item, key)) + found = pos; + } + + return found; +} val pos_if(val pred, val list, val key) { @@ -7391,6 +7571,26 @@ val pos_if(val pred, val list, val key) return nil; } +val rpos_if(val pred, val list, val key) +{ + val pos = zero; + val found = nil; + key = default_arg(key, identity_f); + list = nullify(list); + + gc_hint(list); + + for (; list; list = cdr(list), pos = plus(pos, one)) { + val item = car(list); + val subj = funcall1(key, item); + + if (funcall1(pred, subj)) + found = pos; + } + + return found; +} + val pos_max(val seq, val testfun, val keyfun) { val pos = zero; @@ -8015,8 +8215,74 @@ val search(val seq, val key, val testfun, val keyfun) default: type_mismatch(lit("search: ~s is not a sequence"), seq, nao); } +} - return seq; +static val rsearch_list(val seq, val key, val testfun, val keyfun) +{ + val siter, kiter; + val pos = zero; + val found = nil; + + switch (type(key)) { + case NIL: + return pos; + case CONS: + case LCONS: + case LIT: + case STR: + case LSTR: + case VEC: + /* TODO: optimize me */ + gc_hint(seq); + + for (; seq; seq = cdr(seq)) { + for (siter = seq, kiter = key; + siter && kiter; + siter = cdr(siter), kiter = cdr(kiter)) + { + if (!funcall2(testfun, + funcall1(keyfun, car(siter)), + funcall1(keyfun, car(kiter)))) + { + pos = plus(pos, one); + break; + } + } + + if (!kiter) + found = pos; + + if (!siter) + break; + } + break; + default: + type_mismatch(lit("rsearch: ~s is not a sequence"), seq, nao); + } + + return found; +} + +val rsearch(val seq, val key, val testfun, val keyfun) +{ + testfun = default_arg(testfun, equal_f); + keyfun = default_arg(keyfun, identity_f); + seq = nullify(seq); + + switch (type(seq)) { + case NIL: + return if3(length(key) == zero, zero, nil); + case CONS: + case LCONS: + case LIT: + case STR: + case LSTR: + case VEC: + /* TODO: optimize me */ + return rsearch_list(seq, key, testfun, keyfun); + default: + type_mismatch(lit("rsearch: ~s is not a sequence"), seq, nao); + } } val where(val func, val seq) @@ -532,10 +532,15 @@ val split(val seq, val indices); val partition_star(val seq, val indices); val split_star(val seq, val indices); val memq(val obj, val list); +val rmemq(val obj, val list); val memql(val obj, val list); +val rmemql(val obj, val list); val memqual(val obj, val list); +val rmemqual(val obj, val list); val member(val item, val list, val testfun, val keyfun); +val rmember(val item, val list, val testfun, val keyfun); val member_if(val pred, val list, val key); +val rmember_if(val pred, val list, val key); val remq(val obj, val list); val remql(val obj, val list); val remqual(val obj, val list); @@ -905,14 +910,21 @@ val sort_group(val seq, val keyfun, val lessfun); val unique(val seq, val keyfun, struct args *hashv_args); val uniq(val seq); val find(val list, val key, val testfun, val keyfun); +val rfind(val list, val key, val testfun, val keyfun); val find_if(val pred, val list, val key); +val rfind_if(val pred, val list, val key); val find_max(val seq, val testfun, val keyfun); val find_min(val seq, val testfun, val keyfun); val posqual(val obj, val list); +val rposqual(val obj, val list); val posql(val obj, val list); +val rposql(val obj, val list); val posq(val obj, val list); +val rposq(val obj, val list); val pos(val list, val key, val testfun, val keyfun); +val rpos(val list, val key, val testfun, val keyfun); val pos_if(val pred, val list, val key); +val rpos_if(val pred, val list, val key); val pos_max(val seq, val testfun, val keyfun); val pos_min(val seq, val testfun, val keyfun); val take(val count, val seq); @@ -935,6 +947,7 @@ val butlast(val seq); val replace(val seq, val items, val from, val to); val update(val seq, val fun); val search(val seq, val key, val from, val to); +val rsearch(val seq, val key, val from, val to); val where(val func, val seq); val sel(val seq, val where); val rcons(val from, val to); @@ -15957,6 +15957,26 @@ is returned, otherwise what is returned is the suffix of .meta sequence which begins with the matching element. +.coNP Functions @, rmemq @, rmemql @, rmemqual @ rmember and @ rmember-if +.synb +.mets (rmemq < object << list ) +.mets (rmemql < object << list ) +.mets (rmemqual < object << list ) +.mets (rmember < key < sequence >> [ testfun <> [ keyfun ]]) +.mets (rmember-if < predfun < sequence <> [ keyfun ]) +.syne +.desc +These functions are counterparts to +.codn memq , +.codn memql , +.codn memqual , +.code member +and +.code member-if which look for the right-most +element which matches +.metn object , +rather than for the left-most element. + .coNP Functions @ conses and @ conses* .synb .mets (conses << list ) @@ -21419,6 +21439,24 @@ with one argument. If it is not supplied, it defaults to [search "abcd" #(#\eC #\eD) : chr-toupper] -> 2 .cble +.coNP Function @ rsearch +.synb +.mets (rsearch < haystack < needle >> [ testfun <> [ keyfun ]) +.syne +.desc +The +.code rsearch +function is like +.code search +except that if +.meta needle +matches +.meta haystack +in multiple places, +.code rsearch +returns the right-most matching position rather than +the leftmost. + .coNP Functions @ ref and @ refset .synb .mets (ref < seq << index ) @@ -21687,7 +21725,7 @@ which is identical to being .codn (fun identity) . -.coNP Functions @, posqual @ posql and @ posq +.coNP Functions @, posq @ posql and @ posqual .synb .mets (posq < object << list ) .mets (posql < object << list ) @@ -21781,6 +21819,25 @@ no such element is found, .code nil is returned. +.coNP Functions @, rposq @, rposql @, rposqual @ rpos and @ rpos-if +.synb +.mets (rposq < object << list ) +.mets (rposql < object << list ) +.mets (rposqual < object << list ) +.mets (rpos < key < list >> [ testfun <> [ keyfun ]]) +.mets (rpos-if < predfun < list <> [ keyfun ]) +.syne +.desc +These functions are counterparts of +.codn rposq , +.codn rposql , +.codn rposqual , +.code rpos +and +.codn rpos-if +which report position of the right-most matching item, +rather than the left-most. + .coNP Functions @ pos-max and @ pos-min .synb .mets (pos-max < sequence >> [ testfun <> [ keyfun ]]) @@ -22311,6 +22368,27 @@ element is found, .code nil is returned. +.coNP Functions @ rfind and @ rfind-if +.synb +.mets (rfind < key < sequence >> [ testfun <> [ keyfun ]]) +.mets (rfind-if < predfun < sequence <> [ keyfun ]) +.syne +.desc +The +.code rfind +and +.code rfind-if +functions are almost exactly like +.code find +and +.code find-if +except that if there are multiple matches for +.meta key +in +.metn sequence , +they return the right-most element rather than +the leftmost. + .coNP Functions @ find-max and @ find-min .synb .mets (find-max < sequence >> [ testfun <> [ keyfun ]]) |