;stack ;node is (value . (prev . next)) ;bottom -> bla -> bla -> top (define sentinel-value 'sentinel) (define (make-stack-node value prev next) (cons value (cons prev next))) ;sets both sides (define (set-node-prev! node to) (set-car! (cdr node) to) (set-cdr! (cdr to) node)) (define node-value car) (define node-next cddr) (define node-prev cadr) ;set-next is really jsut set-prev with node ;and to switched (define (set-node-next! node to) (set-node-prev! to node)) (define (make-stack) (let ((ret (cons 0 (cons (make-stack-node sentinel-value '() '()) (make-stack-node sentinel-value '() '()))))) (set-node-prev! (cddr ret) (cadr ret)) ret)) (define (stack-bottom stack) ;first non-sentinel (node-next (cadr stack))) (define (stack-top stack) ;last non-sentinel (node-prev (cddr stack))) (define (stack-empty? stack) ;if 1 before sent is sent (eq? sentinel-value (node-value (stack-top stack)))) (define stack-len car) (define (stack-pop! stack) (if (stack-empty? stack) #f (let ((ret (node-value (stack-top stack)))) ;set end sentinel val to one ;before last element (set-node-prev! (cddr stack) (node-prev (stack-top stack))) (set-car! stack (- (stack-len stack) 1)) ret))) (define (stack-push! stack value) (let ((node (make-stack-node value '() '()))) (set-node-prev! node (stack-top stack)) (set-node-prev! (cddr stack) node) (set-car! stack (+ (stack-len stack) 1)))) (define (stack->list stack) (define (loop node) (if (eq? sentinel-value (node-value node)) '() (cons (node-value node) (loop (node-next node))))) (loop (stack-bottom stack)))