100 lines
1.7 KiB
Scheme
100 lines
1.7 KiB
Scheme
(load "util.scm")
|
|
|
|
(display "\nex-3.12 - append!\n")
|
|
|
|
(define (append x y)
|
|
(if (null? x)
|
|
y
|
|
(cons (car x) (append (cdr x) y))))
|
|
|
|
(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 x (list 'a 'b))
|
|
(define y (list 'c 'd))
|
|
(define z (append x y))
|
|
|
|
(assert z '(a b c d))
|
|
(assert (cdr x) '(b))
|
|
(define w (append! x y))
|
|
(assert w '(a b c d))
|
|
(assert (cdr x) '(b c d))
|
|
|
|
(display "\nex-3.13 - make cycle\n")
|
|
|
|
(define (make-cycle x)
|
|
(set-cdr! (last-pair x) x)
|
|
x)
|
|
|
|
(define z (make-cycle (list 'a 'b 'c)))
|
|
|
|
(display "[see comment]\n")
|
|
; infinite loop
|
|
; (last-pair z)
|
|
|
|
(display "\nex-3.14 - mystery\n")
|
|
|
|
; reverse
|
|
(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 v (list 'a 'b 'c 'd))
|
|
(define w (mystery v))
|
|
|
|
(display v) (newline)
|
|
(display w) (newline)
|
|
|
|
(display "\nex-3.15\n")
|
|
|
|
(define x (list 'a 'b))
|
|
(define z1 (cons x x))
|
|
(define z2 (cons (list 'a 'b) (list 'a 'b)))
|
|
|
|
(define (set-to-wow! x)
|
|
(set-car! (car x) 'wow)
|
|
x)
|
|
|
|
(assert z1 '((a b) a b))
|
|
(set-to-wow! z1)
|
|
(assert z1 '((wow b) wow b))
|
|
(set-to-wow! z2)
|
|
(assert z2 '((wow b) a b))
|
|
|
|
|
|
(display "\nex-3.16 - count pairs\n")
|
|
|
|
(define (count-pairs x)
|
|
(if (not (pair? x))
|
|
0
|
|
(+ (count-pairs (car x))
|
|
(count-pairs (cdr x))
|
|
1)))
|
|
|
|
(define r3 '(1 2 3))
|
|
;(define r4 '())
|
|
;(define r7 '())
|
|
;(define r-never '())
|
|
|
|
(assert (count-pairs r3) 3)
|
|
;(assert (count-pairs r4) 4)
|
|
;(assert (count-pairs r7) 7)
|
|
;(assert (count-pairs r-never) '())
|
|
|
|
(display "\nex-3.17 - count pairs improved\n")
|
|
|
|
|
|
(display "\nex-3.18\n")
|
|
|