;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%;
; This file is part of the programming project "Programmeerproject 2de ;
; bachelor 2005-2006: Implementation and Simulation of an Operating System", ;
; which is taught at the Vrije Universiteit Brussel, Belgium. ;
; ;
; Neither the name of Vrije Universiteit Brussel or the names of contributors ;
; may be used to endorse or promote products derived from this software ;
; without specific prior written permission. ;
; ;
; @author: Clement Herssens ;
; @file: datastructures/circularlist.scm ;
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%;
; CIRCULAR DOUBLE LINKED LIST
; ---------------------------
(define (<CDLL>)
(letrec ((previous-ptr 0)
(data 1)
(next-ptr 2)
(make-node
(lambda (data)
(let ((node (vector 'NIL data 'NIL)))
(vector-set! node previous-ptr node)
(vector-set! node next-ptr node)
node)))
(make-empty-node
(lambda ()
(make-node 'EMPTY)))
(current-node
(make-empty-node))
(get-current-node
(lambda ()
current-node))
(get-previous-node
(lambda (node)
(vector-ref node previous-ptr)))
(set-previous-node!
(lambda (node prev)
(vector-set! node previous-ptr prev)))
(get-next-node
(lambda (node)
(vector-ref node next-ptr)))
(set-next-node!
(lambda (node next)
(vector-set! node next-ptr next)))
(get-node-data
(lambda (node)
(vector-ref node data)))
(empty-node?
(lambda (node)
(eq? (get-node-data node) 'EMPTY)))
(empty?
(lambda ()
(empty-node? current-node)))
(head
(lambda ()
(if (empty?)
#f
(get-node-data current-node))))
(rotate
(lambda ()
(set! current-node (get-next-node current-node))))
(insert
(lambda (el)
(if (empty-node? current-node)
(set! current-node (make-node el))
(let* ((node (make-node el))
(CDLL-head current-node)
(CDLL-tail (get-previous-node CDLL-head)))
; change de pointer from the last node to the new head
(set-next-node! CDLL-tail node)
; set the pointers of the new node
(set-previous-node! node CDLL-tail)
(set-next-node! node CDLL-head)
; set the pointer from the old first node to the new head
(set-previous-node! CDLL-head node)))))
(delete-head
(lambda ()
(let* ((CDLL-head current-node)
(CDLL-next (get-next-node CDLL-head))
(CDLL-tail (get-previous-node CDLL-head)))
; check if it was the last element in the CDLL by verifying
; if the previous and the next node point to node itself
; (even an empty node refers to itself)
(if (and (eq? CDLL-head CDLL-tail)
(eq? CDLL-head CDLL-next))
(set! current-node (make-empty-node))
(begin
; set the tail of the CDLL to point to the next node
(set-next-node! CDLL-tail CDLL-next)
; set the next node of the CDLL to point to the tail
(set-previous-node! CDLL-next CDLL-tail)
; update the current node with the next node
(rotate))))))
)
(define (dispatch msg . args)
(cond ((eq? msg 'head) (apply head args))
((eq? msg 'insert) (apply insert args))
((eq? msg 'delete-head) (apply delete-head args))
((eq? msg 'rotate) (apply rotate args))
(else (error "<CDLL> -- Unknown Command: " msg)))
)
dispatch)
)
; TESTCASES
; ---------
(define cdll (<CDLL>))
(cdll 'insert 1)
(cdll 'insert 2)
(cdll 'insert 3)
(cdll 'head)
(cdll 'rotate)
(cdll 'head)
(cdll 'delete-head)
(cdll 'head)
(cdll 'rotate)
(cdll 'head)
(cdll 'delete-head)
(cdll 'head)
(cdll 'delete-head)
(cdll 'head)