summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-12-22 07:13:33 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-12-22 07:13:33 -0800
commit638293d5281db1276a3b64f2eb969ad99c0ee9f3 (patch)
treeb9d369af312ea49431b89ae2da96a5e9e9f3e82f
parent75b1508c61d3805d1678a8dabf8d48b9e76c8d37 (diff)
downloadtxr-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.c4
-rw-r--r--lib.c33
-rw-r--r--lib.h4
-rw-r--r--stdlib/doc-syms.tl4
-rw-r--r--stdlib/optimize.tl5
-rw-r--r--tests/012/seq.tl50
-rw-r--r--txr.186
7 files changed, 181 insertions, 5 deletions
diff --git a/eval.c b/eval.c
index 817d6627..af5c1505 100644
--- a/eval.c
+++ b/eval.c
@@ -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));
diff --git a/lib.c b/lib.c
index 79ad82a0..cce37b3a 100644
--- a/lib.c
+++ b/lib.c
@@ -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);
diff --git a/lib.h b/lib.h
index 8a39cfc7..2d7650ff 100644
--- a/lib.h
+++ b/lib.h
@@ -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))
diff --git a/txr.1 b/txr.1
index f7c9ae8c..76be9f33 100644
--- a/txr.1
+++ b/txr.1
@@ -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 ]])