83 lines
2.8 KiB
Scheme
83 lines
2.8 KiB
Scheme
|
;;; Copyright (C) Peter McGoron 2024
|
||
|
|
;;; 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, version 3 of the License.
|
||
|
|
;;;
|
||
|
|
;;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;;; Singly linked list with tail pointer, message passing style.
|
||
|
|
|
||
|
|
;;; LINKED-LIST-ELEM:
|
||
|
|
;;;
|
||
|
|
;;; (NEXT): Goes to the next element, if it exists. Does nothing if the
|
||
|
|
;;; iterator is at the end of the list.
|
||
|
|
;;; (GET): Gets the element at this list, signals error if at the end
|
||
|
|
;;; of the list.
|
||
|
|
;;; (EMPTY?): True if there are no more values to go to.
|
||
|
|
|
||
|
|
(define linked-list-elem:new
|
||
|
|
(lambda (ptr)
|
||
|
|
(lambda args
|
||
|
|
(let ((op (car args)))
|
||
|
|
(cond
|
||
|
|
((eq? op 'next)
|
||
|
|
(if (not (null? ptr))
|
||
|
|
(set! ptr (cdr ptr))
|
||
|
|
#f)
|
||
|
|
(null? ptr))
|
||
|
|
((eq? op 'get) (car ptr))
|
||
|
|
((eq? op 'empty?) (null? ptr)))))))
|
||
|
|
|
||
|
|
;;; LINKED-LIST:
|
||
|
|
;;;
|
||
|
|
;;; (PUSH): Pushes a value to the head of the list.
|
||
|
|
;;; (PUSH-TAIL): Pushes a value to the end of the list.
|
||
|
|
;;; (TO-LIST): Returns a list structure.
|
||
|
|
;;; (TRAVERSE-FROM-HEAD): Returns an instance of LINKED-LIST-ELEM pointing
|
||
|
|
;;; to the head of the list.
|
||
|
|
|
||
|
|
(define linked-list:new
|
||
|
|
(lambda ()
|
||
|
|
(let ((head '())
|
||
|
|
(tail '()))
|
||
|
|
(letrec ((push
|
||
|
|
(lambda (val)
|
||
|
|
(set! head (cons val head))
|
||
|
|
(if (null? tail)
|
||
|
|
(set! tail head)
|
||
|
|
#f)))
|
||
|
|
(push-tail
|
||
|
|
(lambda (val)
|
||
|
|
(if (null? tail)
|
||
|
|
(push val)
|
||
|
|
(begin
|
||
|
|
(set-cdr! tail (cons val '()))
|
||
|
|
(set! tail (cdr tail))))))
|
||
|
|
(%set-cdr!
|
||
|
|
(lambda (val)
|
||
|
|
(if (null? tail)
|
||
|
|
(error "cannot set cdr of empty list")
|
||
|
|
(set-cdr! tail val)))))
|
||
|
|
(lambda args
|
||
|
|
(let ((op (car args)))
|
||
|
|
(cond
|
||
|
|
((eq? op 'push) (apply push (cdr args)))
|
||
|
|
((eq? op 'push-tail) (apply push-tail (cdr args)))
|
||
|
|
((eq? op 'set-cdr!) (apply %set-cdr! (cdr args)))
|
||
|
|
((eq? op 'to-list) head)
|
||
|
|
((eq? op 'traverse-from-head) (linked-list-elem:new head))
|
||
|
|
(else (error (cons "invalid operation" args))))))))))
|
||
|
|
|
||
|
|
(define x (linked-list:new))
|
||
|
|
(x 'push-tail 1)
|
||
|
|
(x 'push-tail 2)
|
||
|
|
(x 'push-tail 3)
|
||
|
|
(x 'to-list)
|
||
|
|
|