Permalink
Browse files

Add solutions to section 5.3

  • Loading branch information...
1 parent 5de1d2e commit 007ef6da099dffe31d00f68ec68a280c0b0887d7 @fastred committed Jan 5, 2013
Showing with 193 additions and 0 deletions.
  1. +21 −0 5_20.scm
  2. +100 −0 5_21.scm
  3. +72 −0 5_22.scm
View
@@ -0,0 +1,21 @@
+
+ +----+----+ +----+----+
+ | ++| +------->| + | / |
+ +---|+----+ +--|-+----+
+ | |
+ | |
+ |++------------+
+ vv
+ +----+----+
+ | + | + |
+ +-|--+-|--+
+ | |
+ v v
+ 1 2
+
+ 0 1 2 3
+the-cars n1 p1 p1
+the-cdrs n2 p3 e0
+
+
+'free' pointer will contain p4 after this evaluation.
View
100 5_21.scm
@@ -0,0 +1,100 @@
+(load "ch5-regsim.scm")
+
+(define cl-machine
+ (make-machine
+ '(tree val continue temp)
+ (list (list '= =) (list '* *) (list '+ +) (list '- -) (list '< <)
+ (list 'list list) (list 'null? null?) (list 'cons cons)
+ (list 'car car) (list 'cdr cdr) (list 'pair? pair?)
+ (list 'not not))
+ '(
+ (assign continue (label cl-done))
+ cl-loop
+ (test (op null?) (reg tree))
+ (branch (label null-tree))
+ (assign temp (op pair?) (reg tree))
+ (test (op not) (reg temp))
+ (branch (label not-pair))
+ ; set up to compute (count-leaves (car tree))
+ (save continue)
+ (assign continue (label after-cl-car))
+ (save tree) ; save old tree
+ (assign tree (op car) (reg tree))
+ (goto (label cl-loop))
+ after-cl-car
+ (restore tree)
+ (restore continue)
+ ; set up to compute (count-leaves (cdr tree))
+ (assign tree (op cdr) (reg tree))
+ (save continue)
+ (assign continue (label after-cl-cdr))
+ (save val) ; save (count-leaves (cdr tree))
+ (goto (label cl-loop))
+ after-cl-cdr
+ (assign temp (reg val)) ; temp now contains (count-leaves (cdr tree))
+ (restore val) ; val now contains (count-leaves (car tree))
+ (restore continue)
+ (assign val (op +) (reg temp) (reg val)) ; sum of leaves in branches
+ (goto (reg continue))
+ null-tree
+ (assign val (const 0)) ; if (null? tree)
+ (goto (reg continue))
+ not-pair
+ (assign val (const 1)) ; if (not (pair? tree))
+ (goto (reg continue))
+ cl-done)))
+
+
+(define a (cons (list 1 2) (list 3 4)))
+(set-register-contents! cl-machine 'tree (cons a a))
+(start cl-machine)
+(get-register-contents cl-machine 'val)
+
+
+(define cl-iter-machine
+ (make-machine
+ '(tree val continue temp n)
+ (list (list '= =) (list '* *) (list '+ +) (list '- -) (list '< <)
+ (list 'list list) (list 'null? null?) (list 'cons cons)
+ (list 'car car) (list 'cdr cdr) (list 'pair? pair?)
+ (list 'not not))
+ '(
+ (assign continue (label cl-done))
+ (assign n (const 0))
+ ci-loop
+ (test (op null?) (reg tree))
+ (branch (label null-tree))
+ (assign temp (op pair?) (reg tree))
+ (test (op not) (reg temp))
+ (branch (label not-pair))
+ ; set up to compute (count-iter (car tree) n))
+ (save continue)
+ (save tree) ; save old tree
+ (assign continue (label after-ci-car))
+ (assign tree (op car) (reg tree))
+ (goto (label ci-loop))
+ after-ci-car
+ (restore tree)
+ (restore continue)
+ ; set up to compute (count-iter (cdr tree) ...
+ (assign tree (op cdr) (reg tree))
+ (assign n (reg val)) ; n is set to the result of (count-iter (car ...
+ (save continue)
+ (assign continue (label after-ci-cdr))
+ (goto (label ci-loop))
+ after-ci-cdr ; val contains result
+ (restore continue)
+ (goto (reg continue))
+ null-tree
+ (assign val (reg n)) ; if (null? tree)
+ (goto (reg continue))
+ not-pair
+ (assign val (op +) (reg n) (const 1)) ; if (not (pair? tree))
+ (goto (reg continue))
+ cl-done)))
+
+
+(set-register-contents! cl-iter-machine 'tree (cons a a))
+(start cl-iter-machine)
+(get-register-contents cl-iter-machine 'val)
+
View
@@ -0,0 +1,72 @@
+(load "ch5-regsim.scm")
+
+(define append-machine
+ (make-machine
+ '(x y val continue)
+ (list (list '= =) (list '* *) (list '+ +) (list '- -) (list '< <)
+ (list 'list list) (list 'null? null?) (list 'cons cons)
+ (list 'car car) (list 'cdr cdr) (list 'pair? pair?)
+ (list 'not not))
+ '(
+ (assign continue (label append-done))
+ append-loop
+ (test (op null?) (reg x))
+ (branch (label null-x))
+ ; set up to compute (append (cdr x) y)
+ (save continue)
+ (assign continue (label after-append-cdr))
+ (save x)
+ (assign x (op cdr) (reg x))
+ (goto (label append-loop))
+ after-append-cdr
+ (restore x)
+ (restore continue)
+ ; compute (cons (car x) (append (cdr x) y))))
+ (assign x (op car) (reg x))
+ (assign val (op cons) (reg x) (reg val))
+ (goto (reg continue))
+ null-x
+ (assign val (reg y)) ; if (null? x)
+ (goto (reg continue))
+ append-done)))
+
+(define x (list 'a 'b))
+(define y (list 'c 'd))
+(set-register-contents! append-machine 'x x)
+(set-register-contents! append-machine 'y y)
+(start append-machine)
+(get-register-contents append-machine 'val)
+
+(define append!-machine
+ (make-machine
+ '(x y val continue temp)
+ (list (list '= =) (list '* *) (list '+ +) (list '- -) (list '< <)
+ (list 'list list) (list 'null? null?) (list 'cons cons)
+ (list 'car car) (list 'cdr cdr) (list 'pair? pair?)
+ (list 'not not) (list 'set-cdr! set-cdr!))
+ '(
+ (assign continue (label append!-body))
+ (goto (label last-pair))
+ append!-body
+ ;(set-cdr! (last-pair x) y)
+ (perform (op set-cdr!) (reg val) (reg y))
+ (goto (label append!-done))
+ last-pair ; last-pair procedure - returns result in register val
+ (save x) ; we save x because we will alter it in this procedure
+ lp-loop
+ (assign temp (op cdr) (reg x))
+ (test (op null?) (reg temp))
+ (branch (label lp-done))
+ (assign x (op cdr) (reg x))
+ (goto (label lp-loop))
+ lp-done
+ (assign val (reg x))
+ (restore x)
+ (goto (reg continue))
+ append!-done)))
+
+(set-register-contents! append!-machine 'x x)
+(set-register-contents! append!-machine 'y y)
+(start append!-machine)
+(get-register-contents append!-machine 'x)
+

0 comments on commit 007ef6d

Please sign in to comment.