Mercurial > hg > xemacs-beta
diff lisp/pcl-cvs/dll-debug.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 131b0175ea99 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/pcl-cvs/dll-debug.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,315 @@ +;;; dll-debug -- A slow implementation of dll for debugging. +;;; $Id: dll-debug.el,v 1.1.1.1 1996/12/18 03:32:26 steve Exp $ + +;; Copyright (C) 1991-1995 Free Software Foundation + +;; Author: Per Cederqvist <ceder@lysator.liu.se> +;; Maintainer: elib-maintainers@lysator.liu.se +;; Created: before 24 Sep 1991 +;; Keywords: extensions, lisp + +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Elib; see the file COPYING. If not, write to +;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA + +;;; Commentary: + +;;; This is a plug-in replacement for dll.el. It is dreadfully +;;; slow, but it facilitates debugging. Don't trust the comments in +;;; this file too much. +(provide 'dll) + +;;; +;;; A doubly linked list consists of one cons cell which holds the tag +;;; 'DL-LIST in the car cell and the list in the cdr +;;; cell. The doubly linked list is implemented as a normal list. You +;;; should use dll.el and not this package in debugged code. This +;;; package is not written for speed... +;;; + +;;; Code: + +;;; ================================================================ +;;; Internal functions for use in the doubly linked list package + +(defun dll-get-dummy-node (dll) + + ;; Return the dummy node. INTERNAL USE ONLY. + dll) + +(defun dll-list-nodes (dll) + + ;; Return a list of all nodes in DLL. INTERNAL USE ONLY. + + (cdr dll)) + +(defun dll-set-from-node-list (dll list) + + ;; Set the contents of DLL to the nodes in LIST. + ;; INTERNAL USE ONLY. + + (setcdr dll list)) + +(defun dll-get-node-before (dll node) + ;; Return the node in DLL that points to NODE. Use + ;; (dll-get-node-before some-list nil) to get the last node. + ;; INTERNAL USE ONLY. + (while (and dll (not (eq (cdr dll) node))) + (setq dll (cdr dll))) + (if (not dll) + (error "Node not on list")) + dll) + +(defmacro dll-insert-after (node element) + (let ((node-v (make-symbol "node")) + (element-v (make-symbol "element"))) + (` (let (((, node-v) (, node)) + ((, element-v) (, element))) + (setcdr (, node-v) (cons (, element-v) (cdr (, node-v)))))))) + +;;; =================================================================== +;;; The public functions which operate on doubly linked lists. + +(defmacro dll-element (dll node) + + "Get the element of a NODE in a doubly linked list DLL. +Args: DLL NODE." + + (` (car (, node)))) + + +(defun dll-create () + "Create an empty doubly linked list." + (cons 'DL-LIST nil)) + + +(defun dll-p (object) + "Return t if OBJECT is a doubly linked list, otherwise return nil." + (eq (car-safe object) 'DL-LIST)) + + +(defun dll-enter-first (dll element) + "Add an element first on a doubly linked list. +Args: DLL ELEMENT." + (setcdr dll (cons element (cdr dll)))) + + +(defun dll-enter-last (dll element) + "Add an element last on a doubly linked list. +Args: DLL ELEMENT." + (dll-insert-after (dll-get-node-before dll nil) element)) + + +(defun dll-enter-after (dll node element) + "In the doubly linked list DLL, insert a node containing ELEMENT after NODE. +Args: DLL NODE ELEMENT." + + (dll-get-node-before dll node) + (dll-insert-after node element)) + + +(defun dll-enter-before (dll node element) + "In the doubly linked list DLL, insert a node containing ELEMENT before NODE. +Args: DLL NODE ELEMENT." + + (dll-insert-after (dll-get-node-before dll node) element)) + + + +(defun dll-next (dll node) + "Return the node after NODE, or nil if NODE is the last node. +Args: DLL NODE." + + (dll-get-node-before dll node) + (cdr node)) + + +(defun dll-previous (dll node) + "Return the node before NODE, or nil if NODE is the first node. +Args: DLL NODE." + + (let ((prev (dll-get-node-before dll node))) + (if (eq dll prev) + nil + prev))) + + +(defun dll-delete (dll node) + + "Delete NODE from the doubly linked list DLL. +Args: DLL NODE. Return the element of node." + + (setcdr (dll-get-node-before dll node) (cdr node)) + (car node)) + + +(defun dll-delete-first (dll) + + "Delete the first NODE from the doubly linked list DLL. +Return the element. Args: DLL. Returns nil if the DLL was empty." + + (prog1 + (car (cdr dll)) + (setcdr dll (cdr (cdr dll))))) + + +(defun dll-delete-last (dll) + + "Delete the last NODE from the doubly linked list DLL. +Return the element. Args: DLL. Returns nil if the DLL was empty." + + (let* ((last (dll-get-node-before dll nil)) + (semilast (dll-get-node-before dll last))) + (if (eq last dll) + nil + (setcdr semilast nil) + (car last)))) + + +(defun dll-first (dll) + + "Return the first element on the doubly linked list DLL. +Return nil if the list is empty. The element is not removed." + + (car (cdr dll))) + + + + +(defun dll-last (dll) + + "Return the last element on the doubly linked list DLL. +Return nil if the list is empty. The element is not removed." + + (let ((last (dll-get-node-before dll nil))) + (if (eq last dll) + nil + (car last)))) + + + +(defun dll-nth (dll n) + + "Return the Nth node from the doubly linked list DLL. + Args: DLL N +N counts from zero. If DLL is not that long, nil is returned. +If N is negative, return the -(N+1)th last element. +Thus, (dll-nth dll 0) returns the first node, +and (dll-nth dll -1) returns the last node." + + ;; Branch 0 ("follow left pointer") is used when n is negative. + ;; Branch 1 ("follow right pointer") is used otherwise. + + (if (>= n 0) + (nthcdr n (cdr dll)) + (unwind-protect + (progn (setcdr dll (nreverse (cdr dll))) + (nthcdr (- n) dll)) + (setcdr dll (nreverse (cdr dll)))))) + +(defun dll-empty (dll) + + "Return t if the doubly linked list DLL is empty, nil otherwise" + + (not (cdr dll))) + +(defun dll-length (dll) + + "Returns the number of elements in the doubly linked list DLL." + + (length (cdr dll))) + + + +(defun dll-copy (dll &optional element-copy-fnc) + + "Return a copy of the doubly linked list DLL. +If optional second argument ELEMENT-COPY-FNC is non-nil it should be +a function that takes one argument, an element, and returns a copy of it. +If ELEMENT-COPY-FNC is not given the elements are not copied." + + (if element-copy-fnc + (cons 'DL-LIST (mapcar element-copy-fnc (cdr dll))) + (copy-sequence dll))) + + +(defun dll-all (dll) + + "Return all elements on the double linked list DLL as an ordinary list." + + (cdr dll)) + + +(defun dll-clear (dll) + + "Clear the doubly linked list DLL, i.e. make it completely empty." + + (setcdr dll nil)) + + +(defun dll-map (map-function dll) + + "Apply MAP-FUNCTION to all elements in the doubly linked list DLL. +The function is applied to the first element first." + + (mapcar map-function (cdr dll))) + + +(defun dll-map-reverse (map-function dll) + + "Apply MAP-FUNCTION to all elements in the doubly linked list DLL. +The function is applied to the last element first." + + (unwind-protect + (setcdr dll (nreverse (cdr dll))) + (mapcar map-function (cdr dll)) + (setcdr dll (nreverse (cdr dll))))) + + +(defun dll-create-from-list (list) + + "Given an elisp LIST create a doubly linked list with the same elements." + + (cons 'DL-LIST list)) + + + +(defun dll-sort (dll predicate) + + "Sort the doubly linked list DLL, stably, comparing elements using PREDICATE. +Returns the sorted list. DLL is modified by side effects. +PREDICATE is called with two elements of DLL, and should return T +if the first element is \"less\" than the second." + + (setcdr dll (sort (cdr dll) predicate)) + dll) + + +(defun dll-filter (dll predicate) + + "Remove all elements in the doubly linked list DLL for which PREDICATE +return nil." + + (let* ((prev dll) + (node (cdr dll))) + + (while node + (cond + ((funcall predicate (car node)) + (setq prev node)) + (t + (setcdr prev (cdr node)))) + (setq node (cdr node))))) + +;; dll-debug.el ends here