;;; This software is free under the zlib license, see LICENSE for details
; a dlist is a structure that
; 1 - Can be used by the standard Lisp functions for list walking (dolist, etc)
; 2 - Can be traversed in either direction quickly
; 3 - Given a node of a dlist you can obtain the nodes to either side of it
;
; Each dlist node contains 2 pointers, one to a list forward of this node and one
; to a list backwards of this node. The head of each list starts by pointing back at
; the current node.
; a -> b -> c -> NIL
; O O O ; nodes
; NIL <- A <- B <- C
(in-package :vial)
(defclass dnode ()
((forward :initform nil :accessor forward-from)
(backward :initform nil :accessor backward-from)))
(defclass data-node (dnode)
((data :initarg :data :accessor data-of)))
(defclass dlist ()
((forward :initform nil :accessor forward)
(backward :initform nil :accessor backward)))
(defmethod initialize-instance :after ((node dnode) &key)
(setf (forward-from node) (list node)
(backward-from node) (list node)))
(defun dpush (new-node dlist)
(let ((start-node (first (forward dlist))))
(splice-in-node nil new-node start-node)
(setf (forward dlist) (forward-from new-node))
(unless (backward dlist)
(setf (backward dlist) (backward-from new-node)))
dlist))
(defun dappend (new-node dlist)
(let ((last-node (first (backward dlist))))
(splice-in-node last-node new-node nil)
(setf (backward dlist) (backward-from new-node))
(unless (forward dlist)
(setf (forward dlist) (forward-from new-node)))
dlist))
(defun splice-in-node (prev new next)
(when next
(setf (forward-from new) (cons new (forward-from next))
(cdr (backward-from next)) (backward-from new)))
(when prev
(setf (cdr (backward-from new)) (backward-from prev)
(cdr (forward-from prev)) (forward-from new)))
new)
(defun node-before (node)
(when node
(second (backward-from node))))
(defun node-after (node)
(when node
(second (forward-from node))))
(defun delete-node (node)
(let ((before (node-before node))
(after (node-after node)))
(when before
(setf (rest (forward-from before)) (rest (forward-from node))))
(when after
(setf (rest (backward-from after)) (rest (backward-from node))))))
(defun delete-node-from-dlist (dlist node)
(delete-node node)
(when (eq (forward dlist) (forward-from node))
(setf (forward dlist) (rest (forward-from node))))
(when (eq (backward dlist) (backward-from node))
(setf (backward dlist) (rest (backward-from node)))))