(and (consp (cdr x))
(cons (car x) (butlast (cdr x)))))
-(defun member (x list)
+(defun member (x list &key (key #'identity) (test #'eql))
(while list
- (when (eql x (car list))
+ (when (funcall test x (funcall key (car list)))
(return list))
(setq list (cdr list))))
(defun assoc (x alist &key (test #'eql))
(while alist
(if (funcall test x (caar alist))
- (return)
- (setq alist (cdr alist))))
+ (return)
+ (setq alist (cdr alist))))
(car alist))
+(defun rassoc (x alist &key (test #'eql))
+ (while alist
+ (if (funcall test x (cdar alist))
+ (return)
+ (setq alist (cdr alist))))
+ (car alist))
+
+(defun acons (key datum alist)
+ (cons (cons key datum) alist))
+
+(defun pairlis (keys data &optional (alist ()))
+ (while keys
+ (setq alist (acons (car keys) (car data) alist))
+ (setq keys (cdr keys))
+ (setq data (cdr data)))
+ alist)
+
+(defun copy-alist (alist)
+ (let ((new-alist ()))
+ (while alist
+ (push (cons (caar alist) (cdar alist)) new-alist)
+ (setq alist (cdr alist)))
+ (reverse new-alist)))
(define-setf-expander car (x)
(3rd y 2nd)) ;3rd follows 2nd down the list.
((atom 2nd) 3rd)
(rplacd 2nd 3rd)))
+
+
+(defun adjoin (item list &key (test #'eql) (key #'identity))
+ (if (member item list :key key :test test)
+ list
+ (cons item list)))
+
+(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))