sicp4

sicp4.rkt

#lang racket

(define (mlist . elem)
  (mcons (car elem)
	 (if (null? (cdr elem))
	     '()
	     (apply mlist (cdr elem)))))

;; has-cycle

(define (cycle? p1 p2)
  (cond
   ((eq? p1 p2) #t)
   ((not (mpair? p2)) #f)
   ((not (mpair? (mcdr p2))) #f)
   (else (cycle? (mcdr p1) (mcdr (mcdr p2))))))

(define (has-cycle? xs)
  (cycle? xs (mcdr xs)))

(define (last-pair x)
  (if (not (mpair? (mcdr x))) x (last-pair (mcdr x))))

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

(define (list-with-cycle xs)
  (make-cycle xs)
  xs)

(define lol (mlist 1 2 3 4 5 6))

(define lol-1 (list-with-cycle (mlist 1 2 3 4 5)))

;; make-queue

(define (make-queue)
  (let* ((front-ptr '())
	 (rear-ptr front-ptr))
    (define (empty?)
      (null? front-ptr))
    (define (front-queue)  ;; peek
      (if (empty?)
	  (error "empty")
	  (mcar front-ptr)))
    (define (insert-queue elem)  ;; push
      (if (empty?)
	  (begin
	    (set! front-ptr (mcons elem '()))
	    (set! rear-ptr front-ptr))
	  (let ((t (mcons elem '())))
	    (set-mcdr! rear-ptr t)
	    (set! rear-ptr t))))
    (define (delete-queue)    ;; pop
      (if (empty?)
	  (error "empty")
	  (let ((elem (mcar front-ptr)))
	    (set! front-ptr (mcdr front-ptr))
	    elem)))
    (define (dispatch m)
      (cond ((eq? m 'empty?) empty?)
	    ((eq? m 'front-queue) front-queue)
	    ((eq? m 'insert-queue) insert-queue)
	    ((eq? m 'delete-queue) delete-queue)
	    (else (error "undefined op"))))
    dispatch))