| ... |
... |
@@ -749,6 +749,7 @@ |
|
749
|
749
|
(defparameter *min-list-length-for-hashtable*
|
|
750
|
750
|
15)
|
|
751
|
751
|
|
|
|
752
|
+(declaim (start-block list-to-hashtable union intersection set-difference))
|
|
752
|
753
|
;; Convert a list to a hashtable. The hashtable does not handle
|
|
753
|
754
|
;; duplicated values in the list. Returns the hashtable.
|
|
754
|
755
|
(defun list-to-hashtable (list key test test-not)
|
| ... |
... |
@@ -802,29 +803,6 @@ |
|
802
|
803
|
(push item res)))))
|
|
803
|
804
|
res))
|
|
804
|
805
|
|
|
805
|
|
-;;; Destination and source are setf-able and many-evaluable. Sets the source
|
|
806
|
|
-;;; to the cdr, and "conses" the 1st elt of source to destination.
|
|
807
|
|
-;;;
|
|
808
|
|
-(defmacro steve-splice (source destination)
|
|
809
|
|
- `(let ((temp ,source))
|
|
810
|
|
- (setf ,source (cdr ,source)
|
|
811
|
|
- (cdr temp) ,destination
|
|
812
|
|
- ,destination temp)))
|
|
813
|
|
-
|
|
814
|
|
-(defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp))
|
|
815
|
|
- "Destructively returns the union list1 and list2."
|
|
816
|
|
- (declare (inline member))
|
|
817
|
|
- (if (and testp notp)
|
|
818
|
|
- (error "Test and test-not both supplied."))
|
|
819
|
|
- (let ((res list2)
|
|
820
|
|
- (list1 list1))
|
|
821
|
|
- (do ()
|
|
822
|
|
- ((endp list1))
|
|
823
|
|
- (if (not (with-set-keys (member (apply-key key (car list1)) list2)))
|
|
824
|
|
- (steve-splice list1 res)
|
|
825
|
|
- (setf list1 (cdr list1))))
|
|
826
|
|
- res))
|
|
827
|
|
-
|
|
828
|
806
|
|
|
829
|
807
|
(defun intersection (list1 list2 &key key
|
|
830
|
808
|
(test #'eql testp) (test-not nil notp))
|
| ... |
... |
@@ -847,20 +825,6 @@ |
|
847
|
825
|
(push elt res)))
|
|
848
|
826
|
res)))))
|
|
849
|
827
|
|
|
850
|
|
-(defun nintersection (list1 list2 &key key
|
|
851
|
|
- (test #'eql testp) (test-not nil notp))
|
|
852
|
|
- "Destructively returns the intersection of list1 and list2."
|
|
853
|
|
- (declare (inline member))
|
|
854
|
|
- (if (and testp notp)
|
|
855
|
|
- (error "Test and test-not both supplied."))
|
|
856
|
|
- (let ((res nil)
|
|
857
|
|
- (list1 list1))
|
|
858
|
|
- (do () ((endp list1))
|
|
859
|
|
- (if (with-set-keys (member (apply-key key (car list1)) list2))
|
|
860
|
|
- (steve-splice list1 res)
|
|
861
|
|
- (setq list1 (Cdr list1))))
|
|
862
|
|
- res))
|
|
863
|
|
-
|
|
864
|
828
|
(defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp))
|
|
865
|
829
|
"Returns the elements of list1 which are not in list2."
|
|
866
|
830
|
(declare (inline member))
|
| ... |
... |
@@ -888,6 +852,45 @@ |
|
888
|
852
|
(push item res)))
|
|
889
|
853
|
res)))))
|
|
890
|
854
|
|
|
|
855
|
+(declaim (end-block))
|
|
|
856
|
+
|
|
|
857
|
+;;; Destination and source are setf-able and many-evaluable. Sets the source
|
|
|
858
|
+;;; to the cdr, and "conses" the 1st elt of source to destination.
|
|
|
859
|
+;;;
|
|
|
860
|
+(defmacro steve-splice (source destination)
|
|
|
861
|
+ `(let ((temp ,source))
|
|
|
862
|
+ (setf ,source (cdr ,source)
|
|
|
863
|
+ (cdr temp) ,destination
|
|
|
864
|
+ ,destination temp)))
|
|
|
865
|
+
|
|
|
866
|
+(defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp))
|
|
|
867
|
+ "Destructively returns the union list1 and list2."
|
|
|
868
|
+ (declare (inline member))
|
|
|
869
|
+ (if (and testp notp)
|
|
|
870
|
+ (error "Test and test-not both supplied."))
|
|
|
871
|
+ (let ((res list2)
|
|
|
872
|
+ (list1 list1))
|
|
|
873
|
+ (do ()
|
|
|
874
|
+ ((endp list1))
|
|
|
875
|
+ (if (not (with-set-keys (member (apply-key key (car list1)) list2)))
|
|
|
876
|
+ (steve-splice list1 res)
|
|
|
877
|
+ (setf list1 (cdr list1))))
|
|
|
878
|
+ res))
|
|
|
879
|
+
|
|
|
880
|
+(defun nintersection (list1 list2 &key key
|
|
|
881
|
+ (test #'eql testp) (test-not nil notp))
|
|
|
882
|
+ "Destructively returns the intersection of list1 and list2."
|
|
|
883
|
+ (declare (inline member))
|
|
|
884
|
+ (if (and testp notp)
|
|
|
885
|
+ (error "Test and test-not both supplied."))
|
|
|
886
|
+ (let ((res nil)
|
|
|
887
|
+ (list1 list1))
|
|
|
888
|
+ (do () ((endp list1))
|
|
|
889
|
+ (if (with-set-keys (member (apply-key key (car list1)) list2))
|
|
|
890
|
+ (steve-splice list1 res)
|
|
|
891
|
+ (setq list1 (Cdr list1))))
|
|
|
892
|
+ res))
|
|
|
893
|
+
|
|
891
|
894
|
(defun nset-difference (list1 list2 &key key
|
|
892
|
895
|
(test #'eql testp) (test-not nil notp))
|
|
893
|
896
|
"Destructively returns the elements of list1 which are not in list2."
|