Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 97 lines (80 sloc) 4.313 kb
a225209 @krzysz00 First commit.
authored
1 (in-package #:dlist)
2
fab495c @krzysz00 Generic sequence protocol related changes.
authored
3 (defclass dlist (#+generic-sequences sequence standard-object)
4 ((first :initarg :first :accessor %dlist-first)
5 (last :initarg :last :accessor %dlist-last))
6 (:documentation "A class that represents a doubly-linked list"))
a225209 @krzysz00 First commit.
authored
7
8 (defun dlist-first (dlist)
fab495c @krzysz00 Generic sequence protocol related changes.
authored
9 "Gets the first `dcons' in a `dlist'"
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
10 (cond
11 ((not dlist) nil)
12 ((typep dlist 'dcons) dlist)
13 (t (%dlist-first dlist))))
a225209 @krzysz00 First commit.
authored
14
15 (defun dlist-last (dlist)
fab495c @krzysz00 Generic sequence protocol related changes.
authored
16 "Gets the last `dcons' in a `dlist'"
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
17 (cond
18 ((not dlist) nil)
19 ((typep dlist 'dcons) (loop for i = dlist then (next dlist) while (next i) finally (return i)))
20 (t (%dlist-last dlist))))
a225209 @krzysz00 First commit.
authored
21
22 (defun (setf dlist-first) (val place)
23 (setf (%dlist-first place) val))
24
25 (defun (setf dlist-last) (val place)
26 (setf (%dlist-last place) val))
27
28 (defun dlist-cons-on (object dlist)
fab495c @krzysz00 Generic sequence protocol related changes.
authored
29 "Returns a dlist whose elements are `object' and the elements of `dlist'. `dlist' is destructively mosified. This is intended to have the same use as @code{(cons object list)} for regular lists."
a225209 @krzysz00 First commit.
authored
30 (let ((new-cons (dcons nil object dlist)))
31 (setf (prev dlist) new-cons)
32 new-cons))
33
34 (defun dcons-append (object dcons)
35 "Creates a dcons whose `data' is `object' and appends it to `dcons', returning `dcons' with a pointer to the new dcons in `dcons''s next."
36 (let ((new-dcons (dcons dcons object nil)))
37 (setf (next dcons) new-dcons)
38 dcons))
39
40 (defun dlist (&rest elements)
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
41 "Returns a doubly-linked list (dlist) with the elements in `elements'"
a225209 @krzysz00 First commit.
authored
42 (when elements
4ebb9bc @krzysz00 Added a bunch of stuff
authored
43 (if (= (length elements) 1)
fab495c @krzysz00 Generic sequence protocol related changes.
authored
44 (let* ((dcons (dcons nil (car elements) nil)) (dlist (make-instance 'dlist :first dcons :last dcons)))
4ebb9bc @krzysz00 Added a bunch of stuff
authored
45 dlist)
fab495c @krzysz00 Generic sequence protocol related changes.
authored
46 (let ((dlist (make-instance 'dlist)) (current-dcons nil))
4ebb9bc @krzysz00 Added a bunch of stuff
authored
47 (setf (dlist-first dlist) (dcons nil (first elements) nil))
48 (setf current-dcons (dlist-first dlist))
49 (loop for i on (rest elements) do
50 (setf current-dcons (next (dcons-append (car i) current-dcons)))
51 (or (cdr i) (setf (dlist-last dlist) current-dcons)))
52 dlist))))
a225209 @krzysz00 First commit.
authored
53
54 (defun dlist= (dlist &rest more-dlists)
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
55 "Tests dlists for equality by element, recursively descending into sub-dlists."
a225209 @krzysz00 First commit.
authored
56 (unless more-dlists (return-from dlist= t))
57 (if (cdr more-dlists) ;;Test for a list of length > 1
58 (every #'(lambda (x) (dlist= dlist x)) more-dlists)
59 (loop for i = (dlist-first dlist) then (next i)
60 for j = (dlist-first (first more-dlists)) then (next j)
61 until (and (eql i nil) (eql j nil))
62 always
63 (if (and (typep (data i) 'dlist) (typep (data j) 'dlist))
64 (dlist= (data i) (data j))
65 (equal (data i) (data j))))))
66
4ebb9bc @krzysz00 Added a bunch of stuff
authored
67 (defun dlistp (object)
68 "Tests if `object' is a dlist."
fab495c @krzysz00 Generic sequence protocol related changes.
authored
69 (or (typep object 'dlist) (not object)))
4ebb9bc @krzysz00 Added a bunch of stuff
authored
70
a225209 @krzysz00 First commit.
authored
71 (defun dlist->list (dlist)
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
72 "Converts a dlist to a list"
a225209 @krzysz00 First commit.
authored
73 (loop for i = (dlist-first dlist) then (next i) while i collect (data i)))
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
74
c4edea3 @krzysz00 Added generic sequence support. Fixed that test
authored
75 (defun nthdcons (n dlist &key from-end)
76 "Returns the @code{n}th dcons in `dlist' (zero-based). If n is >= the length of the list, returns NIL. If `from-end' is true, returns the @code{n}th dcons from the end."
77 (let ((val (funcall (if from-end #'dlist-last #'dlist-first) dlist)))
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
78 (dotimes (i n val)
c4edea3 @krzysz00 Added generic sequence support. Fixed that test
authored
79 (setf val (if from-end (prev val) (next val))))))
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
80
c4edea3 @krzysz00 Added generic sequence support. Fixed that test
authored
81 (defun dlist-nth (n dlist &key from-end)
82 "Returns the nth element of `dlist', as the primary value. If n is >= the length of the list, NIL will be returned. The secondary value will be T if the value was actually found in the list, and NIL otherwise. If `from-end' is true, `dlist-nth' returns the @code{n}th element from the end, subject to the rules above."
83 (let ((ret (nthdcons n dlist :from-end from-end)))
b4d2e08 @krzysz00 Added push/pop and all sorts of features.
authored
84 (values (data ret) (not (not ret)))))
85
c4edea3 @krzysz00 Added generic sequence support. Fixed that test
authored
86 (defun (setf dlist-nth) (val n dlist &key from-end)
87 "Sets the data of the nth dcons in `dlist' to `val'. If `from-end' is true, sets the @code{n}th element from the end."
88 (setf (data (nthdcons n dlist :from-end from-end)) val))
4ebb9bc @krzysz00 Added a bunch of stuff
authored
89
fab495c @krzysz00 Generic sequence protocol related changes.
authored
90 (defmethod print-object ((object dlist) stream)
91 (print-unreadable-object (object stream :type t)
c4edea3 @krzysz00 Added generic sequence support. Fixed that test
authored
92 (format stream "~s" (dlist->list object))))
fab495c @krzysz00 Generic sequence protocol related changes.
authored
93
94 (defmethod describe-object ((dlist dlist) stream)
95 (let ((*print-circle* t))
c4edea3 @krzysz00 Added generic sequence support. Fixed that test
authored
96 (format stream "~&~S is a doubly-linked list (dlist) which has the elements ~%~S.~% Its first dcons is: ~%~S~%. Its last dcons is ~%~S~%" dlist (dlist->list dlist) (dlist-first dlist) (dlist-last dlist))))
Something went wrong with that request. Please try again.