From 0c49e3197f5713c72f2d088a4c9f382f6c019ad2 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
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