;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%;
; 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)
(_EMPTY 'EMPTY)
(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)