From: Owen Rodley <Strigoides@gmail.com>
Date: Sat, 4 May 2013 06:34:48 +0000 (+1200)
Subject: INTERSECTION
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8de6bd35930e6f3c3e37b9800955faf81882971d;p=jscl.git

INTERSECTION
---

diff --git a/src/list.lisp b/src/list.lisp
index 02d1984..0bd4846 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -263,3 +263,11 @@
        (3rd y 2nd))               ;3rd follows 2nd down the list.
       ((atom 2nd) 3rd)
     (rplacd 2nd 3rd)))
+
+
+(defun intersection (list1 list2 &key (test #'eql) (key #'identity))
+  (let ((new-list ()))
+    (dolist (x list1)
+      (when (member x list2 :test test :key key)
+        (push x new-list)))
+    new-list))
diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 99d8602..35edf4f 100644
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -62,9 +62,9 @@
           fdefinition fifth find-package find-symbol first flet format fourth
           fset funcall function functionp gensym get-internal-real-time
           get-setf-expansion get-universal-time go identity if in-package
-          incf integerp intern keywordp labels lambda last length let let* list
-          list* list-all-packages listp loop make-array make-package
-          make-symbol mapcar member minusp mod multiple-value-bind
+          incf integerp intern intersection keywordp labels lambda last length
+          let let* list list* list-all-packages listp loop make-array
+          make-package make-symbol mapcar member minusp mod multiple-value-bind
           multiple-value-call multiple-value-list multiple-value-prog1
           nconc nil ninth not nreconc nth nthcdr null numberp or otherwise
           package-name package-use-list packagep pairlis parse-integer plusp
diff --git a/tests/list.lisp b/tests/list.lisp
index d8086e2..ad5eb62 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -69,6 +69,11 @@
 (test (equal (member 4 '((1 . 2) (3 . 4)) :key #'cdr) '((3 . 4))))
 (test (member '(2) '((1) (2) (3)) :test #'equal))
 
+; INTERSECTION
+(test (equal (intersection '(1 2) '(2 3)) '(2)))
+(test (not (intersection '(1 2 3) '(4 5 6))))
+(test (equal (intersection '((1) (2)) '((2) (3)) :test #'equal) '((2))))
+
 ; SUBST
 ; Can't really test this until EQUAL works properly on lists