From 0c49e3197f5713c72f2d088a4c9f382f6c019ad2 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 30 Mar 2022 23:27:14 -0700 Subject: New function: isecp. * eval.c (eval_init): Register isecp intrinsic. * lib.c (isecp): New function. * lib.h (isecp): Declared. * stdlib/compiler.tl (lambda-apply-transform, dump-compiled-objects): Use isecp instead of isec, since the actual intersection of symbols isn't needed, only whether it exists. * txr.1: Documented. * stdlib/doc-syms.tl: Updated. --- eval.c | 1 + lib.c | 32 ++++++++++++++++++++++++++++++++ lib.h | 1 + stdlib/compiler.tl | 4 ++-- stdlib/doc-syms.tl | 9 +++++---- txr.1 | 12 +++++++++++- 6 files changed, 52 insertions(+), 7 deletions(-) diff --git a/eval.c b/eval.c index a1fc263a..ed3c88f7 100644 --- a/eval.c +++ b/eval.c @@ -7350,6 +7350,7 @@ void eval_init(void) reg_fun(intern(lit("diff"), user_package), func_n4o(diff, 2)); reg_fun(intern(lit("symdiff"), user_package), func_n4o(symdiff, 2)); reg_fun(intern(lit("isec"), user_package), func_n4o(isec, 2)); + reg_fun(intern(lit("isecp"), user_package), func_n4o(isecp, 2)); reg_fun(intern(lit("uni"), user_package), func_n4o(uni, 2)); reg_fun(intern(lit("seqp"), user_package), func_n1(seqp)); diff --git a/lib.c b/lib.c index fecb68c2..7c7422f2 100644 --- a/lib.c +++ b/lib.c @@ -12186,6 +12186,38 @@ val isec(val seq1, val seq2, val testfun, val keyfun) return make_like(out, seq1); } +val isecp(val seq1, val seq2, val testfun, val keyfun) +{ + val self = lit("isecp"); + val out = nil; + seq_iter_t si1, si2; + val el1; + + testfun = default_arg(testfun, equal_f); + keyfun = default_arg(keyfun, identity_f); + + seq_iter_init(self, &si1, seq1); + seq_iter_init_with_rewind(self, &si2, seq2); + + while (seq_get(&si1, &el1)) { + val el1_key = funcall1(keyfun, el1); + val el2; + + seq_iter_rewind(&si2, self); + + while (seq_get(&si2, &el2)) { + val el2_key = funcall1(keyfun, el2); + + if (funcall2(testfun, el1_key, el2_key)) { + out = t; + break; + } + } + } + + return out; +} + val uni(val seq1, val seq2, val testfun, val keyfun) { val self = lit("uni"); diff --git a/lib.h b/lib.h index 0bc7013e..b5b59b38 100644 --- a/lib.h +++ b/lib.h @@ -1233,6 +1233,7 @@ val set_diff(val list1, val list2, val testfun, val keyfun); val diff(val seq1, val seq2, val testfun, val keyfun); val symdiff(val seq1, val seq2, val testfun, val keyfun); val isec(val list1, val list2, val testfun, val keyfun); +val isecp(val list1, val list2, val testfun, val keyfun); val uni(val list1, val list2, val testfun, val keyfun); val copy(val seq); val length(val seq); diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 7d9cb515..63ceb519 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -2037,7 +2037,7 @@ (al-val (gensym)) (shadow-p (let ((all-vars (append pars.req pars.(opt-syms) (if pars.rest (list pars.rest))))) - (or (isec all-vars fix-arg-iter) + (or (isecp all-vars fix-arg-iter) (member apply-list-expr all-vars))))) ^(,(if shadow-p 'let 'alet) ,(zip fix-vals fix-arg-iter) (let* ,(build @@ -2406,7 +2406,7 @@ self obj))))) (symvec (sys:vm-desc-symvec vm-desc))) out.(add (list-from-vm-desc vm-desc)) - (when (isec symvec %package-manip%) + (when (isecp symvec %package-manip%) out.(add :fence))))) (dump-to-tlo out-stream out)))) diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 5ce5c0d0..53d01739 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -479,7 +479,7 @@ ("delete-package" "N-02E687F3") ("derived" "N-0151798B") ("dev-t" "N-01153D9E") - ("diff" "N-0385B074") + ("diff" "N-00DFDE76") ("digits" "N-03CC559E") ("digpow" "N-030C5561") ("dir-name" "N-02C01721") @@ -1037,7 +1037,8 @@ ("ipv6-v6only" "N-001E8B40") ("iread" "N-03FE5500") ("isatty" "N-03709E8A") - ("isec" "N-0385B074") + ("isec" "N-00DFDE76") + ("isecp" "N-00DFDE76") ("isig" "N-0072FF5E") ("isqrt" "D-0038") ("istrip" "N-02391683") @@ -1920,7 +1921,7 @@ ("symbol-package" "N-02AB2428") ("symbol-value" "N-00004DDC") ("symbolp" "N-01C0BF69") - ("symdiff" "N-0385B074") + ("symdiff" "N-00DFDE76") ("symlink" "N-009EF0C8") ("sys:abscond*" "N-02DF20E5") ("sys:abscond-from" "N-02E20FE2") @@ -2084,7 +2085,7 @@ ("uname" "N-0308D954") ("unget-byte" "D-0007") ("unget-char" "D-0055") - ("uni" "N-0385B074") + ("uni" "N-00DFDE76") ("unintern" "N-01B6BFC2") ("union" "N-01C78B86") ("union-get" "N-02FA4F0C") diff --git a/txr.1 b/txr.1 index 7ffc3d13..8ae02f17 100644 --- a/txr.1 +++ b/txr.1 @@ -35442,10 +35442,11 @@ function, these functions behave the same as and .codn find-min . -.coNP Functions @, uni @, isec @ diff and @ symdiff +.coNP Functions @, uni @, isec @, isecp @ diff and @ symdiff .synb .mets (uni < iter1 < iter1 >> [ testfun <> [ keyfun ]]) .mets (isec < iter1 < iter1 >> [ testfun <> [ keyfun ]]) +.mets (isecp < iter1 < iter1 >> [ testfun <> [ keyfun ]]) .mets (diff < iter1 < iter1 >> [ testfun <> [ keyfun ]]) .mets (symdiff < iter1 < iter2 >> [ testfun <> [ keyfun ]]) .syne @@ -35469,6 +35470,15 @@ and .metn iter2 , returning a new sequence. +The +.code isecp +is Boolean: it returns +.code t +for those arguments for which +.code isec +returns a non-empty list, otherwise +.codn nil . + The arguments .meta iter1 and -- cgit v1.2.3