diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-12-22 07:13:33 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-12-22 07:13:33 -0800 |
commit | 638293d5281db1276a3b64f2eb969ad99c0ee9f3 (patch) | |
tree | b9d369af312ea49431b89ae2da96a5e9e9f3e82f | |
parent | 75b1508c61d3805d1678a8dabf8d48b9e76c8d37 (diff) | |
download | txr-638293d5281db1276a3b64f2eb969ad99c0ee9f3.tar.gz txr-638293d5281db1276a3b64f2eb969ad99c0ee9f3.tar.bz2 txr-638293d5281db1276a3b64f2eb969ad99c0ee9f3.zip |
New functions: subq, subql, subqual and subst.
* eval.c (eval_init): Register new intrinsics.
* lib.c, lib.h (subq, subql, subqual, subst): New functions.
* tests/012/seq.tl: New test cases.
* stdlib/optimize.tl (subst): Function removed. The new subst
drop-in replaces this one.
* txr.1: Documented.
* stdlib/doc-syms.tl: Updated.
-rw-r--r-- | eval.c | 4 | ||||
-rw-r--r-- | lib.c | 33 | ||||
-rw-r--r-- | lib.h | 4 | ||||
-rw-r--r-- | stdlib/doc-syms.tl | 4 | ||||
-rw-r--r-- | stdlib/optimize.tl | 5 | ||||
-rw-r--r-- | tests/012/seq.tl | 50 | ||||
-rw-r--r-- | txr.1 | 86 |
7 files changed, 181 insertions, 5 deletions
@@ -6981,6 +6981,10 @@ void eval_init(void) 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("subq"), user_package), func_n3(subq)); + reg_fun(intern(lit("subql"), user_package), func_n3(subql)); + reg_fun(intern(lit("subqual"), user_package), func_n3(subqual)); + reg_fun(intern(lit("subst"), user_package), func_n5o(subst, 3)); 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)); @@ -11487,6 +11487,39 @@ val pos_min(val seq, val testfun, val keyfun) return pos_max(seq, default_arg(testfun, less_f), keyfun); } +val subq(val oldv, val newv, val seq) +{ + return subst(oldv, newv, seq, eq_f, identity_f); +} + +val subql(val oldv, val newv, val seq) +{ + return subst(oldv, newv, seq, eql_f, identity_f); +} + +val subqual(val oldv, val newv, val seq) +{ + return subst(oldv, newv, seq, equal_f, identity_f); +} + +val subst(val oldv, val newv, val seq, val testfun_in, val keyfun_in) +{ + val self = lit("subst"); + seq_iter_t iter; + seq_iter_init(self, &iter, seq); + val elem; + val testfun = default_arg(testfun_in, equal_f); + val keyfun = default_arg(keyfun_in, identity_f); + list_collect_decl (out, ptail); + + while (seq_get(&iter, &elem)) { + val key = funcall1(keyfun, elem); + ptail = list_collect(ptail, if3(funcall2(testfun, oldv, key), newv, elem)); + } + + return make_like(out, seq); +} + val mismatch(val left, val right, val testfun_in, val keyfun_in) { val testfun = default_arg(testfun_in, equal_f); @@ -1204,6 +1204,10 @@ 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 subq(val oldv, val newv, val seq); +val subql(val oldv, val newv, val seq); +val subqual(val oldv, val newv, val seq); +val subst(val oldv, val newv, val seq, val keyfun_in, val testfun_in); val mismatch(val left, val right, val testfun, val keyfun); val rmismatch(val left, val right, val testfun, val keyfun); val starts_with(val little, val big, val testfun, val keyfun); diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 78229519..6be397ea 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -1887,6 +1887,10 @@ ("sub-str" "N-03CFFEF2") ("sub-tree" "N-0398FBE2") ("sub-vec" "N-03BFFF0A") + ("subq" "N-01B32285") + ("subql" "N-01B32285") + ("subqual" "N-01B32285") + ("subst" "N-01F8EF22") ("subtypep" "N-00699D3B") ("succ" "N-038E636C") ("sum" "N-0163FFE2") diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl index 11b85aca..4b7b3ec5 100644 --- a/stdlib/optimize.tl +++ b/stdlib/optimize.tl @@ -345,11 +345,6 @@ ((nequal ninsn oinsn) (append (ldiff code tail) (list ninsn))) (t code)))) -(defun subst (x y list) - (mapcar (lambda (item) - (if (equal item x) y item)) - list)) - (defun subst-preserve (x y bb li list) (let ((sub (subst x y list))) (cond diff --git a/tests/012/seq.tl b/tests/012/seq.tl index dadb9e9b..ed2e02b8 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -387,3 +387,53 @@ (mtest (let ((s '(a b c))) (list (rot s 33) s)) ((a b c) (a b c)) (let ((s '(a b c))) (list (rot s 34) s)) ((b c a) (a b c))) + +(mtest + (subq #\a #\b "") "" + (subq #\a #\b "a") "b" + (subq #\a #\b "aaa") "bbb" + (subq #\a #\b "abc") "bbc") + +(mtest + (subql #\a #\b "") "" + (subql #\a #\b "a") "b" + (subql #\a #\b "aaa") "bbb" + (subql #\a #\b "abc") "bbc") + +(mtest + (subqual #\a #\b "") "" + (subqual #\a #\b "a") "b" + (subqual #\a #\b "aaa") "bbb" + (subqual #\a #\b "abc") "bbc") + +(mtest + (subq 0 1 nil) nil + (subq 0 1 '(0)) (1) + (subq 0 1 '(0 0 0)) (1 1 1) + (subq 0 1 '(0 1 2)) (1 1 2)) + +(mtest + (subql 0 1 nil) nil + (subql 0 1 '(0)) (1) + (subql 0 1 '(0 0 0)) (1 1 1) + (subql 0 1 '(0 1 2)) (1 1 2)) + +(mtest + (subqual 0 1 nil) nil + (subqual 0 1 '(0)) (1) + (subqual 0 1 '(0 0 0)) (1 1 1) + (subqual 0 1 '(0 1 2)) (1 1 2)) + +(mtest + (subqual "foo" "bar" nil) nil + (subqual "foo" "bar" '#"foo") #"bar" + (subqual "foo" "bar" '#"foo foo foo") #"bar bar bar" + (subqual "foo" "bar" '#"xyzzy foo quuz") #"xyzzy bar quuz") + +(mtest + (subqual "brown" "black" #("how" "now" "brown" "cow")) #("how" "now" "black" "cow") + (subst "brown" "black" #("how" "now" "brown" "cow")) #("how" "now" "black" "cow")) + +(mtest + [subst "brown" "black" #("how" "now" "BROWN" "cow") : downcase-str] #("how" "now" "black" "cow") + [subst 5 0 '(1 2 3 4 5 6 7 8 9 10) <] (1 2 3 4 5 0 0 0 0 0)) @@ -33459,6 +33459,92 @@ elements. To find the rightmost of the maxima, the function can be substituted. Analogous reasoning applies to other test functions. +.coNP Function @ subst +.synb +.mets (subst < old < new < seq >> [ testfun <> [ keyfun ]]) +.syne +.desc +The +.code subst +function returns a sequence of the same type as +.meta seq +in which elements of +.meta seq +which match the +.meta old +object have been replaced with the +.meta new +object. + +To form the comparison keys, the elements of +.meta seq +are projected through the +.meta testfun +function, which defaults to +.codn identity , +so the items themselves are used as keys by default. + +Keys are compared to the +.meta old +value using +.metn testfun , +which defaults to +.codn equal . + +.TP* Examples: + +.verb + (subst "brown" "black" #("how" "now" "brown" "cow")) + -> #("how" "now" "black" "cow")) + + ;; elements are converted to lower case to form keys + [subst "brown" "black" + #("how" "now" "BROWN" "cow") : downcase-str] + -> #("how" "now" "black" "cow") + + ;; using < instead of equality, replace elements + ;; greater than 5 with 0 + [subst 5 0 '(1 2 3 4 5 6 7 8 9 10) <] (1 2 3 4 5 0 0 0 0 0)) +.brev + +.coNP Functions @, subq @ subql and @ subqual +.synb +.mets (subq < old < new << sequence ) +.mets (subql < old < new << sequence ) +.mets (subqual < old < new << sequence ) +.syne +.desc +The +.codn subq , +.code subql +and +.code subqual +functions return a sequence of the same kind as +.meta sequence +in which elements matching the +.meta old +object are replaced by +.meta new +object. + +The matching elements are identified by comparing with +.meta old +using, respectively, the functions +.codn eq , +.codn eql , +and +.codn equal . + +.TP* Examples: + +.verb + (subq #\eb #\ez "abc") -> "azc" + (subql 1 3 #(0 1 2)) -> #(0 3 2) + + (subqual "are" "do" '#"how are you") + -> ("how" "do" "you") +.brev + .coNP Function @ mismatch .synb .mets (mismatch < left-seq < right-seq >> [ testfun <> [ keyfun ]]) |