Mercurial > hg > xemacs-beta

comparison lisp/pcl-cvs/dll.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 131b0175ea99
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; $Id: dll.el,v 1.1.1.1 1996/12/18 03:32:27 steve Exp $
2 ;;; elib-dll.el -- Some primitives for Doubly linked lists.
3
4 ;; Copyright (C) 1991-1995 Free Software Foundation
5
6 ;; Author: Per Cederqvist <ceder@lysator.liu.se>
7 ;; Maintainer: elib-maintainers@lysator.liu.se
8 ;; Created: 24 Sep 1991
9 ;; Keywords: extensions, lisp
10
11 ;;; This program is free software; you can redistribute it and/or modify
12 ;;; it under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 2 of the License, or
14 ;;; (at your option) any later version.
15 ;;;
16 ;;; This program is distributed in the hope that it will be useful,
17 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;;; GNU General Public License for more details.
20 ;;;
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with GNU Elib; see the file COPYING. If not, write to
23 ;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;;; Boston, MA 02111-1307, USA
25 ;;;
26 ;;; Author: Per Cederqvist
27 ;;; ceder@lysator.liu.se.
28
29 (require 'elib-node)
30 (provide 'dll)
31
32 ;;; Commentary:
33
34 ;;; A doubly linked list consists of one cons cell which holds the tag
35 ;;; 'DL-LIST in the car cell and a pointer to a dummy node in the cdr
36 ;;; cell. The doubly linked list is implemented as a circular list
37 ;;; with the dummy node first and last. The dummy node is recognized
38 ;;; by comparing it to the node which the cdr of the cons cell points
39 ;;; to.
40 ;;;
41
42 ;;; Code:
43
44 ;;; ================================================================
45 ;;; Internal functions for use in the doubly linked list package
46
47 (defun dll-get-dummy-node (dll)
48
49 ;; Return the dummy node. INTERNAL USE ONLY.
50 (cdr dll))
51
52 (defun dll-list-nodes (dll)
53
54 ;; Return a list of all nodes in DLL. INTERNAL USE ONLY.
55
56 (let* ((result nil)
57 (dummy (dll-get-dummy-node dll))
58 (node (elib-node-left dummy)))
59
60 (while (not (eq node dummy))
61 (setq result (cons node result))
62 (setq node (elib-node-left node)))
63
64 result))
65
66 (defun dll-set-from-node-list (dll list)
67
68 ;; Set the contents of DLL to the nodes in LIST.
69 ;; INTERNAL USE ONLY.
70
71 (dll-clear dll)
72 (let* ((dummy (dll-get-dummy-node dll))
73 (left dummy))
74 (while list
75 (elib-node-set-left (car list) left)
76 (elib-node-set-right left (car list))
77 (setq left (car list))
78 (setq list (cdr list)))
79
80 (elib-node-set-right left dummy)
81 (elib-node-set-left dummy left)))
82
83
84 ;;; ===================================================================
85 ;;; The public functions which operate on doubly linked lists.
86
87 (defmacro dll-element (dll node)
88
89 "Get the element of a NODE in a doubly linked list DLL.
90 Args: DLL NODE."
91
92 (` (elib-node-data (, node))))
93
94
95 (defun dll-create ()
96 "Create an empty doubly linked list."
97 (let ((dummy-node (elib-node-create nil nil nil)))
98 (elib-node-set-right dummy-node dummy-node)
99 (elib-node-set-left dummy-node dummy-node)
100 (cons 'DL-LIST dummy-node)))
101
102 (defun dll-p (object)
103 "Return t if OBJECT is a doubly linked list, otherwise return nil."
104 (eq (car-safe object) 'DL-LIST))
105
106 (defun dll-enter-first (dll element)
107 "Add an element first on a doubly linked list.
108 Args: DLL ELEMENT."
109 (dll-enter-after
110 dll
111 (dll-get-dummy-node dll)
112 element))
113
114
115 (defun dll-enter-last (dll element)
116 "Add an element last on a doubly linked list.
117 Args: DLL ELEMENT."
118 (dll-enter-before
119 dll
120 (dll-get-dummy-node dll)
121 element))
122
123
124 (defun dll-enter-after (dll node element)
125 "In the doubly linked list DLL, insert a node containing ELEMENT after NODE.
126 Args: DLL NODE ELEMENT."
127
128 (let ((new-node (elib-node-create
129 node (elib-node-right node)
130 element)))
131 (elib-node-set-left (elib-node-right node) new-node)
132 (elib-node-set-right node new-node)))
133
134
135 (defun dll-enter-before (dll node element)
136 "In the doubly linked list DLL, insert a node containing ELEMENT before NODE.
137 Args: DLL NODE ELEMENT."
138
139 (let ((new-node (elib-node-create
140 (elib-node-left node) node
141 element)))
142 (elib-node-set-right (elib-node-left node) new-node)
143 (elib-node-set-left node new-node)))
144
145
146
147 (defun dll-next (dll node)
148 "Return the node after NODE, or nil if NODE is the last node.
149 Args: DLL NODE."
150
151 (if (eq (elib-node-right node) (dll-get-dummy-node dll))
152 nil
153 (elib-node-right node)))
154
155
156 (defun dll-previous (dll node)
157 "Return the node before NODE, or nil if NODE is the first node.
158 Args: DLL NODE."
159
160 (if (eq (elib-node-left node) (dll-get-dummy-node dll))
161 nil
162 (elib-node-left node)))
163
164
165 (defun dll-delete (dll node)
166
167 "Delete NODE from the doubly linked list DLL.
168 Args: DLL NODE. Return the element of node."
169
170 ;; This is a no-op when applied to the dummy node. This will return
171 ;; nil if applied to the dummy node since it always contains nil.
172
173 (elib-node-set-right (elib-node-left node) (elib-node-right node))
174 (elib-node-set-left (elib-node-right node) (elib-node-left node))
175 (dll-element dll node))
176
177
178
179 (defun dll-delete-first (dll)
180
181 "Delete the first NODE from the doubly linked list DLL.
182 Return the element. Args: DLL. Returns nil if the DLL was empty."
183
184 ;; Relies on the fact that dll-delete does nothing and
185 ;; returns nil if given the dummy node.
186
187 (dll-delete dll (elib-node-right (dll-get-dummy-node dll))))
188
189
190 (defun dll-delete-last (dll)
191
192 "Delete the last NODE from the doubly linked list DLL.
193 Return the element. Args: DLL. Returns nil if the DLL was empty."
194
195 ;; Relies on the fact that dll-delete does nothing and
196 ;; returns nil if given the dummy node.
197
198 (dll-delete dll (elib-node-left (dll-get-dummy-node dll))))
199
200
201 (defun dll-first (dll)
202
203 "Return the first element on the doubly linked list DLL.
204 Return nil if the list is empty. The element is not removed."
205
206 (if (eq (elib-node-right (dll-get-dummy-node dll))
207 (dll-get-dummy-node dll))
208 nil
209 (elib-node-data (elib-node-right (dll-get-dummy-node dll)))))
210
211
212
213
214 (defun dll-last (dll)
215
216 "Return the last element on the doubly linked list DLL.
217 Return nil if the list is empty. The element is not removed."
218
219 (if (eq (elib-node-left (dll-get-dummy-node dll))
220 (dll-get-dummy-node dll))
221 nil
222 (elib-node-data (elib-node-left (dll-get-dummy-node dll)))))
223
224
225
226 (defun dll-nth (dll n)
227
228 "Return the Nth node from the doubly linked list DLL.
229 Args: DLL N
230 N counts from zero. If DLL is not that long, nil is returned.
231 If N is negative, return the -(N+1)th last element.
232 Thus, (dll-nth dll 0) returns the first node,
233 and (dll-nth dll -1) returns the last node."
234
235 ;; Branch 0 ("follow left pointer") is used when n is negative.
236 ;; Branch 1 ("follow right pointer") is used otherwise.
237
238 (let* ((dummy (dll-get-dummy-node dll))
239 (branch (if (< n 0) 0 1))
240 (node (elib-node-branch dummy branch)))
241
242 (if (< n 0)
243 (setq n (- -1 n)))
244
245 (while (and (not (eq dummy node))
246 (> n 0))
247 (setq node (elib-node-branch node branch))
248 (setq n (1- n)))
249
250 (if (eq dummy node)
251 nil
252 node)))
253
254
255 (defun dll-empty (dll)
256
257 "Return t if the doubly linked list DLL is empty, nil otherwise"
258
259 (eq (elib-node-left (dll-get-dummy-node dll))
260 (dll-get-dummy-node dll)))
261
262 (defun dll-length (dll)
263
264 "Returns the number of elements in the doubly linked list DLL."
265
266 (let* ((dummy (dll-get-dummy-node dll))
267 (node (elib-node-right dummy))
268 (n 0))
269
270 (while (not (eq node dummy))
271 (setq node (elib-node-right node))
272 (setq n (1+ n)))
273
274 n))
275
276
277
278 (defun dll-copy (dll &optional element-copy-fnc)
279
280 "Return a copy of the doubly linked list DLL.
281 If optional second argument ELEMENT-COPY-FNC is non-nil it should be
282 a function that takes one argument, an element, and returns a copy of it.
283 If ELEMENT-COPY-FNC is not given the elements are not copied."
284
285 (let ((result (dll-create))
286 (node (dll-nth dll 0)))
287 (if element-copy-fnc
288
289 ;; Copy the elements with the user-supplied function.
290 (while node
291 (dll-enter-last result
292 (funcall element-copy-fnc
293 (dll-element dll node)))
294 (setq node (dll-next dll node)))
295
296 ;; Don't try to copy the elements - they might be
297 ;; circular lists, or anything at all...
298 (while node
299 (dll-enter-last result (dll-element dll node))
300 (setq node (dll-next dll node))))
301
302 result))
303
304
305
306 (defun dll-all (dll)
307
308 "Return all elements on the double linked list DLL as an ordinary list."
309
310 (let* ((result nil)
311 (dummy (dll-get-dummy-node dll))
312 (node (elib-node-left dummy)))
313
314 (while (not (eq node dummy))
315 (setq result (cons (dll-element dll node) result))
316 (setq node (elib-node-left node)))
317
318 result))
319
320
321 (defun dll-clear (dll)
322
323 "Clear the doubly linked list DLL, i.e. make it completely empty."
324
325 (elib-node-set-left (dll-get-dummy-node dll) (dll-get-dummy-node dll))
326 (elib-node-set-right (dll-get-dummy-node dll) (dll-get-dummy-node dll)))
327
328
329 (defun dll-map (map-function dll)
330
331 "Apply MAP-FUNCTION to all elements in the doubly linked list DLL.
332 The function is applied to the first element first."
333
334 (let* ((dummy (dll-get-dummy-node dll))
335 (node (elib-node-right dummy)))
336
337 (while (not (eq node dummy))
338 (funcall map-function (dll-element dll node))
339 (setq node (elib-node-right node)))))
340
341
342 (defun dll-map-reverse (map-function dll)
343
344 "Apply MAP-FUNCTION to all elements in the doubly linked list DLL.
345 The function is applied to the last element first."
346
347 (let* ((dummy (dll-get-dummy-node dll))
348 (node (elib-node-left dummy)))
349
350 (while (not (eq node dummy))
351 (funcall map-function (dll-element dll node))
352 (setq node (elib-node-left node)))))
353
354
355 (defun dll-create-from-list (list)
356
357 "Given an elisp LIST create a doubly linked list with the same elements."
358
359 (let ((dll (dll-create)))
360 (while list
361 (dll-enter-last dll (car list))
362 (setq list (cdr list)))
363 dll))
364
365
366
367 (defun dll-sort (dll predicate)
368
369 "Sort the doubly linked list DLL, stably, comparing elements using PREDICATE.
370 Returns the sorted list. DLL is modified by side effects.
371 PREDICATE is called with two elements of DLL, and should return T
372 if the first element is \"less\" than the second."
373
374 (dll-set-from-node-list
375 dll (sort (dll-list-nodes dll)
376 (function (lambda (x1 x2)
377 (funcall predicate
378 (dll-element dll x1)
379 (dll-element dll x2))))))
380 dll)
381
382
383 (defun dll-filter (dll predicate)
384
385 "Remove all elements in the doubly linked list DLL for which PREDICATE
386 returns nil."
387
388 (let* ((dummy (dll-get-dummy-node dll))
389 (node (elib-node-right dummy))
390 next)
391
392 (while (not (eq node dummy))
393 (setq next (elib-node-right node))
394 (if (funcall predicate (dll-element dll node))
395 nil
396 (dll-delete dll node))
397 (setq node next))))
398
399 ;; dll.el ends here