commit 5d5383bb748396da6e1d94e3f6e42651e0be1472 parent 6dcbc63bf32dcd99902d0c72e7a41df2519dd87d Author: Yuval Langer <yuval.langer@gmail.com> Date: Mon, 17 Apr 2023 00:29:43 +0300 Add solution to exercise 3.22. Diffstat:
| A | sicp/solutions/3_22.scm | | | 68 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | sicp/tests/3_22.scm | | | 47 | +++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 115 insertions(+), 0 deletions(-)
diff --git a/sicp/solutions/3_22.scm b/sicp/solutions/3_22.scm @@ -0,0 +1,68 @@ +(define-library (sicp solutions 3_22) + (import (scheme base)) + (import (scheme write)) + (export + delete-queue! + empty-queue? + front-queue + insert-queue! + make-queue + print-queue + queue->list + queue->list + ) + + (begin + (define (make-queue) + (let ([front-ptr '()] + [rear-ptr '()]) + + (define (set-front-ptr! item) + (set! front-ptr item)) + (define (set-rear-ptr! item) + (set! rear-ptr item)) + + (define (empty-queue?) + (null? front-ptr)) + + (define (front-queue) + (if (empty-queue?) + (error "FRONT called with an empty queue" dispatch) + (car front-ptr))) + + (define (insert-queue! item) + (let ([new-pair (cons item '())]) + (cond + ((empty-queue?) + (set-front-ptr! new-pair) + (set-rear-ptr! new-pair) + dispatch) + (else + (set-cdr! rear-ptr new-pair) + (set-rear-ptr! new-pair) + dispatch)))) + + (define (delete-queue!) + (cond + ((empty-queue?) + (error "DELETE! called with an empty queue" dispatch)) + (else + (set-front-ptr! (cdr front-ptr)) + dispatch))) + + (define (print-queue . port) + (if (null? port) + (display front-ptr) + (display front-ptr + (car port)))) + + (define (dispatch m) + (cond + ((eq? 'empty? m) empty-queue?) + ((eq? 'front-queue m) front-queue) + ((eq? 'insert-queue! m) insert-queue!) + ((eq? 'delete-queue! m) delete-queue!) + ((eq? 'print-queue m) print-queue) + (else (error "Unknown command: " m)))) + + dispatch)))) diff --git a/sicp/tests/3_22.scm b/sicp/tests/3_22.scm @@ -0,0 +1,47 @@ +(define-library (sicp tests 3_22) + (import (scheme base)) + (import (scheme write)) + (import (srfi :64)) + (import (sicp solutions 3_22)) + + (begin + (test-begin "3.22") + + (define (test-equal-print-queue string-ratsui queue-matsui) + (define string-port (open-output-string)) + + ((queue-matsui 'print-queue) string-port) + + (define string-matsui + (get-output-string string-port)) + + (test-equal string-ratsui string-matsui)) + + (define q1 (make-queue)) + (test-equal-print-queue "()" q1) + + ((q1 'insert-queue!) 'a) + (test-equal-print-queue "(a)" q1) + + ((q1 'insert-queue!) 'b) + (test-equal-print-queue "(a b)" q1) + + ((q1 'insert-queue!) 'c) + (test-equal-print-queue "(a b c)" q1) + + ((q1 'insert-queue!) 'd) + (test-equal-print-queue "(a b c d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "(b c d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "(c d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "(d)" q1) + + ((q1 'delete-queue!)) + (test-equal-print-queue "()" q1) + + (test-end "3.22")))