blob: fb71fe0a0e7eb8a66ecfc5b7824558944b74c73b (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
;;; 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 'linked-list "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 'linked-list (cons "invalid operation" args))))))))))
(define x (linked-list:new))
(x 'push-tail 1)
(x 'push-tail 2)
(x 'push-tail 3)
(x 'to-list)
|
