aboutsummaryrefslogtreecommitdiffstats
path: root/linked-list.scm
diff options
context:
space:
mode:
authorGravatar Peter McGoron 2024-09-27 11:16:25 -0400
committerGravatar Peter McGoron 2024-09-27 11:16:25 -0400
commitdf698263126d34dd6ce771483526bd1f0142d1f9 (patch)
tree4ae8d1a829fb959c6a6f892782e4e006e9bc4653 /linked-list.scm
parentRevert "object: change to a stateful table" (diff)
Revert "add object helper functions"
Diffstat (limited to 'linked-list.scm')
-rw-r--r--linked-list.scm93
1 files changed, 61 insertions, 32 deletions
diff --git a/linked-list.scm b/linked-list.scm
index c9dff5b..356b2b2 100644
--- a/linked-list.scm
+++ b/linked-list.scm
@@ -12,42 +12,71 @@
;;; 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! VAL): Pushes a value to the head of the list.
-;;; (PUSH-TAIL! VAL): Pushes a value to the end of the list.
-;;; (SET-CDR! VAL): Set the cdr of TAIL to VAL. This will be overrwitten
-;;; if PUSH-TAIL! is called again.
+;;; (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 ()
- (letrec
- ((head '())
- (tail '())
- (this
- (object/procedures
- 'push!
- (lambda (val)
- (set! head (cons val head))
- (if (null? tail)
- (set! tail head))
- this)
- 'push-tail!
- (lambda (val)
- (if (null? tail)
- (this 'push! val)
- (begin
- (set-cdr! tail (cons val '()))
- (set! tail (cdr tail))))
- this)
- 'set-cdr!
- (lambda (val)
- (if (null? tail)
- (error "cannot set cdr of empty list")
- (set-cdr! tail val))
- this)
- 'to-list
- (lambda () head))))
- this)))
+ (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)
+