From 3517907ed86d25003e1f8ae220ef354296d22416 Mon Sep 17 00:00:00 2001
From: pdn <pnathan@vandals.uidaho.edu>
Date: Sat, 15 Feb 2014 00:02:42 -0800
Subject: [PATCH] Add the &optional n for BUTLAST

---
 src/list.lisp   |   30 +++++++++++++++++++++++++-----
 tests/list.lisp |   16 ++++++++++++++++
 2 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/src/list.lisp b/src/list.lisp
index 9cb8e45..7a06dd7 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -246,11 +246,31 @@
     (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)
diff --git a/tests/list.lisp b/tests/list.lisp
index b59f662..db44b9a 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -228,3 +228,19 @@
 (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)) '()))
-- 
1.7.10.4