Mutation.rkt

#lang r5rs

(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)

(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(define (mystery x)
  (define (loop x y)
    (if (null? x)
        y
        (let ((temp (cdr x)))
          (set-cdr! x y)
          (loop temp x))))
  (loop x '()))

(define (count-pairs x)
  (if (not (pair? x))
      0
      (+ (count-pairs (car x))
         (count-pairs (cdr x))
         1)))

(define (elem x list)
  (cond ((null? list) #f)
        ((eq? x (car list)) #t)
        (else (elem x (cdr list)))))

(define (count-pairs-correct x)
  (let ((visited '())
        (count 0))
    (define (aux branch)
      (if (or (elem branch visited) (not (pair? branch)))
          count
          (begin
            (set! visited (cons branch visited))
            (set! count (+ 1 count))
            (aux (car branch))
            (aux (cdr branch)))))
    (aux x)))

(define (cycle? x)
  (let ((visited '()))
    (define (aux branch)
      (cond ((not (pair? branch)) #f)
            ((elem branch visited) #t)
            (else (set! visited (cons branch visited))
                  (or (aux (car branch))
                      (aux (cdr branch))))))
    (aux x)))

(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))

(define (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))

(define (front-queue queue)
  (if (empty-queue? queue)
      "FRONT called with an empty queue"
      (car (front-ptr queue))))

(define (insert-queue! queue item)
  (let ((new-pair (cons item '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (else
           (set-cdr! (rear-ptr queue) new-pair)
           (set-rear-ptr! queue new-pair)
           queue))))

(define (delete-queue! queue)
  (cond ((empty-queue? queue)
         "DELETE! called with an empty queue")
        (else
         (set-front-ptr! queue (cdr (front-ptr queue)))
         queue)))

(define (print-queue q)
  (display (car q)))

(define (make-queue-object)
  (let ((front-ptr '())
        (rear-ptr '()))
    (define (empty-queue?)
      (null? front-ptr))
    (define (front-queue)
      (if (empty-queue?)
          "Error: queue is empty"
          (car front-ptr)))
    (define (insert-queue! elem)
      (let ((new-rear (cons elem '())))
        (if (null? rear-ptr)
            (begin
              (set! rear-ptr new-rear)
              (set! front-ptr new-rear))
            (begin
              (set-cdr! rear-ptr new-rear)
              (set! rear-ptr new-rear)))))
    (define (delete-queue!)
      (if (empty-queue?)
          "Error: queue is empty"
          (set! front-ptr (cdr front-ptr))))
    (define (dispatch m)
      (cond ((eq? m 'empty-queue?) (empty-queue?))
            ((eq? m 'front-queue) (front-queue))
            ((eq? m 'delete-queue!) (delete-queue!))
            ((eq? m 'insert-queue!) insert-queue!)
            (else "Error: unknown message")))
    dispatch))