learning-sicp

My embarrassing half assed SICP run.
git clone https://kaka.farm/~git/learning-sicp
Log | Files | Refs

exercise-21.scm (1641B)

      1 (define-library (sicp solutions chapter-3 exercise-21)
      2   (import (scheme base))
      3   (import (scheme write))
      4   (export
      5    delete-queue!
      6    empty-queue?
      7    front-queue
      8    insert-queue!
      9    make-queue
     10    print-queue
     11    queue->list
     12    queue->list
     13    )
     14 
     15   (begin
     16     (define (front-ptr queue) (car queue))
     17     (define (rear-ptr queue) (cdr queue))
     18     (define (set-front-ptr! queue item)
     19       (set-car! queue item))
     20     (define (set-rear-ptr! queue item)
     21       (set-cdr! queue item))
     22 
     23     (define (empty-queue? queue)
     24       (null? (front-ptr queue)))
     25 
     26     (define (make-queue)
     27       (cons '() '()))
     28 
     29     (define (front-queue queue)
     30       (if (empty-queue? queue)
     31           (error "FRONT called with an empty queue" queue)
     32           (car (front-ptr queue))))
     33 
     34     (define (insert-queue! queue item)
     35       (let ([new-pair (cons item '())])
     36         (cond
     37          ((empty-queue? queue)
     38           (set-front-ptr! queue new-pair)
     39           (set-rear-ptr! queue new-pair)
     40           queue)
     41          (else
     42           ;; XXX
     43           (set-cdr! (rear-ptr queue)
     44                     new-pair)
     45           (set-rear-ptr! queue
     46                          new-pair)
     47           queue))))
     48 
     49     (define (delete-queue! queue)
     50       (cond
     51        ((empty-queue? queue)
     52         (error "DELETE! called with an empty queue" queue))
     53        (else
     54         (set-front-ptr! queue
     55                         (cdr (front-ptr queue)))
     56         queue)))
     57 
     58     (define (queue->list queue)
     59       (front-ptr queue))
     60 
     61     (define (print-queue queue . port)
     62       (if (null? port)
     63           (display (queue->list queue))
     64           (display (queue->list queue)
     65                    (car port))))))