Chapter 5, Computing with Register Machines

Exercise 5.21


(a)

Code turned out quite similar to the book’s version of fibonacci(one with double recursion):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
(define count-leaves-machine
  (make-machine
   '(tree continue count temp)
   (list (list 'null? null?)
		   (list 'pair? pair?)
		   (list 'car car)
		   (list 'cdr cdr)
		   (list 'not not)
		   (list '+ +))
   '((assign continue (label done))
	loop
	 (test (op null?) (reg tree))
	 (branch (label base-case-0))
	 (assign temp (op pair?) (reg tree))
	 (test (op not) (reg temp))
	 (branch (label base-case-1))
	 (save continue)
	 (save tree)
	 (assign continue (label after-car-count))
	 (assign tree (op car) (reg tree))
	 (goto (label loop))
	after-car-count
	 (restore tree)
	 (assign tree (op cdr) (reg tree))
	 (assign continue (label after-cdr-count))
	 (save count)
	 (goto (label loop))
	after-cdr-count
	 (assign temp (reg count))
	 (restore count)
	 (assign count (op +) (reg temp) (reg count))
	 (restore continue)
	 (goto (reg continue))
	base-case-0
	 (assign count (const 0))
	 (goto (reg continue))
	base-case-1
	 (assign count (const 1))
	 (goto (reg continue))
	done)))

Output/Test:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
1 ]=> (define t '((1 . (2 . 3)) . ((4 . 5) . ((6 . ()) . 7))))

;Value: t

1 ]=> t

;Value 56: ((1 2 . 3) (4 . 5) (6) . 7)

1 ]=> 
(define count-leaves-machine
  (make-machine
   '(tree continue count temp)
   (list (list 'null? null?)
		   (list 'pair? pair?)
		   (list 'car car)
		   (list 'cdr cdr)
		   (list 'not not)
		   (list '+ +))
   '((assign continue (label done))
	loop
	 (test (op null?) (reg tree))
	 (branch (label base-case-0))
	 (assign temp (op pair?) (reg tree))
	 (test (op not) (reg temp))
	 (branch (label base-case-1))
	 (save continue)
	 (save tree)
	 (assign continue (label after-car-count))
	 (assign tree (op car) (reg tree))
	 (goto (label loop))
	after-car-count
	 (restore tree)
	 (assign tree (op cdr) (reg tree))
	 (assign continue (label after-cdr-count))
	 (save count)
	 (goto (label loop))
	after-cdr-count
	 (assign temp (reg count))
	 (restore count)
	 (assign count (op +) (reg temp) (reg count))
	 (restore continue)
	 (goto (reg continue))
	base-case-0
	 (assign count (const 0))
	 (goto (reg continue))
	base-case-1
	 (assign count (const 1))
	 (goto (reg continue))
	done)))

;Value: count-leaves-machine

1 ]=> (set-register-contents! count-leaves-machine 'tree t)

;Value: done

1 ]=> (start count-leaves-machine)

;Value: done

1 ]=> (get-register-contents count-leaves-machine 'count)

;Value: 7

1 ]=> 

(b)

Code with example:

(Note that there is still one recursive process(and one iterative process))

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
1 ]=> 
(define count-leaves-iter-machine
  (make-machine
   '(tree count continue temp)
   (list (list 'null? null?)
		   (list 'pair? pair?)
		   (list 'car car)
		   (list 'cdr cdr)
		   (list 'not not)
		   (list '+ +))
   '((assign continue (label done))
	 (assign count (const 0))
	loop
	 (test (op null?) (reg tree))
	 (branch (label base-case-0))
	 (assign temp (op pair?) (reg tree))
	 (test (op not) (reg temp))
	 (branch (label base-case-1))
	 (save continue)
	 (save tree)
	 (assign tree (op cdr) (reg tree))
	 (assign continue (label car-count))
	 (goto (label loop))
	car-count
	 (restore tree)
	 (restore continue)
	 (assign tree (op car) (reg tree))
	 (goto (reg continue))
	base-case-0
	 (goto (reg continue))
	base-case-1
	 (assign count (op +) (reg count) (const 1))
	 (goto (reg continue))
	done)))

;Value: count-leaves-iter-machine

1 ]=> (define t '((1 . (2 . 3)) . ((4 . 5) . ((6 . ()) . 7))))

;Value: t

1 ]=> (set-register-contents! count-leaves-machine 'tree t)

;Value: done

1 ]=> (start count-leaves-iter-machine)

;Value: done

1 ]=> (get-register-contents count-leaves-machine 'count)

;Value: 7

1 ]=>