(setq x (cdr x)))
x)
-(defun butlast (x)
- (and (consp (cdr x))
- (cons (car x) (butlast (cdr x)))))
-
-(defun member (x list &key key (test #'eql testp) (test-not #'eql test-not-p))
+(defun butlast (x &optional (n 1))
+ "Returns x, less the n last elements in the list."
+ (cond
+ ;; trivial optimizations
+ ((not x) x)
+ ((zerop n) x)
+
+ ;; Base case
+ ((= n 1)
+ (and (consp (cdr x))
+ (cons (car x)
+ (butlast (cdr x) n))))
+ ;; O(n * (length x)) butlast for n > 1.
+ (t
+ (let ((temp x))
+ (do
+ ((iter 0))
+ ;; quit when we reach the top or we ran out
+ ((or (= iter n)
+ (not temp)))
+ (setf temp (butlast temp 1))
+ (incf iter))
+ temp))))
+
+(defun member (x list &key key (test #'eql testp) (test-not #'eql test-not-p))
(while list
(when (satisfies-test-p x (car list) :key key :test test :testp testp
:test-not test-not :test-not-p test-not-p)
(test (equal (multiple-value-list (get-properties '(a b c d) '(b d e))) '(NIL NIL NIL)))
(test (equal (multiple-value-list (get-properties '(a b c d) '(b a c))) '(a b (a b c d))))
(test (equal (multiple-value-list (get-properties '(a b c d) '(b c a))) '(a b (a b c d))))
+
+;; BUTLAST
+(test (equal (butlast '()) ()))
+(test (equal (butlast '(1)) ()))
+(test (equal (butlast '(1 2)) '(1)))
+(test (equal (butlast '(1 2 3 4 5)) '(1 2 3 4)))
+(test (equal '(1 2 3 4) (butlast '(1 2 3 4 5))))
+(test (equal (let ((thing '(1 2 3 4 5))) (butlast thing)) '(1 2 3 4)))
+(test (equal (let ((thing '(1 2 3 4 5))) (butlast thing) thing) '(1 2 3 4 5)))
+
+(test (equal (let ((thing '(1 2 3 4 5))) (butlast thing 0)) '(1 2 3 4 5)))
+(test (equal (let ((thing '(1 2 3 4 5))) (butlast thing 1)) '(1 2 3 4)))
+(test (equal (let ((thing '(1 2 3 4 5))) (butlast thing 2)) '(1 2 3)))
+(test (equal (let ((thing '())) (butlast thing 2)) '()))
+(test (equal (let ((thing '(1 2))) (butlast thing 2)) '()))
+(test (equal (let ((thing '())) (butlast thing 0)) '()))