sicp-ex-5.21

meteorgan

  
  
 (a) 
 > (define count-leaves-machine 
   (make-machine 
    (list (list '+ +) (list 'null? null?) 
          (list 'pair? pair?) (list 'car car) (list 'cdr cdr)) 
   '( 
    (assign continue (label count-leaves-done)) 
    (assign val (const 0)) 
   tree-loop 
    (test (op null?) (reg tree)) 
    (branch (label null-tree)) 
    (test (op pair?) (reg tree)) 
    (branch (label left-tree)) 
    (assign val (const 1)) 
    (goto (reg continue)) 
   left-tree 
    (save tree) 
    (save continue) 
    (assign continue (label right-tree)) 
    (assign tree (op car) (reg tree)) 
    (goto (label tree-loop)) 
   right-tree 
    (restore continue) 
    (restore tree) 
    (save continue) 
    (save val) 
    (assign continue (label after-tree)) 
    (assign tree (op cdr) (reg tree)) 
    (goto (label tree-loop)) 
   after-tree 
    (assign var (reg val)) 
    (restore val) 
    (restore continue) 
    (assign val (op +) (reg var) (reg val)) 
    (goto (reg continue)) 
   null-tree 
    (assign val (const 0)) 
    (goto (reg continue)) 
    count-leaves-done))) 
  
 (set-register-contents! count-leaves-machine 'tree '(a (b c (d)) (e f) g)) 
 (start count-leaves-machine) 
 (get-register-contents count-leaves-machine 'val) 
 'done 
 'done 
 7

Rptx

  
 ;; a. 
 (define (not-pair? lst) 
   (not (pair? lst))) 
  
 (define count-leaves 
   (make-machine 
    `((car ,car) (cdr ,cdr) (null? ,null?) 
                 (not-pair? ,not-pair?) (+ ,+)) 
    '( 
      start 
        (assign continue (label done)) 
        (assign n (const 0)) 
      count-loop 
        (test (op null?) (reg lst)) 
        (branch (label null)) 
        (test (op not-pair?) (reg lst)) 
        (branch (label not-pair)) 
        (save continue) 
        (assign continue (label after-car)) 
        (save lst) 
        (assign lst (op car) (reg lst)) 
        (goto (label count-loop)) 
      after-car 
        (restore lst) 
        (assign lst (op cdr) (reg lst)) 
        (assign continue (label after-cdr)) 
        (save val) 
        (goto (label count-loop)) 
      after-cdr 
        (restore n) 
        (restore continue) 
        (assign val 
                (op +) (reg val) (reg n)) 
        (goto (reg continue)) 
      null 
        (assign val (const 0)) 
        (goto (reg continue)) 
      not-pair 
        (assign val (const 1)) 
        (goto (reg continue)) 
      done))) 
  
 ;; b. 
  
 (define count-leaves 
   (make-machine 
    `((car ,car) (cdr ,cdr) (pair? ,pair?) 
                 (null? ,null?) (+ ,+)) 
    '( 
      start 
        (assign val (const 0)) 
        (assign continue (label done)) 
        (save continue) 
        (assign continue (label cdr-loop)) 
      count-loop 
        (test (op pair?) (reg lst)) 
        (branch (label pair)) 
        (test (op null?) (reg lst)) 
        (branch (label null)) 
        (assign val (op +) (reg val) (const 1)) 
        (restore continue) 
        (goto (reg continue)) 
      cdr-loop 
        (restore lst) 
        (assign lst (op cdr) (reg lst)) 
        (goto (label count-loop)) 
      pair 
        (save lst) 
        (save continue) 
        (assign lst (op car) (reg lst)) 
        (goto (label count-loop)) 
      null 
        (restore continue) 
        (goto (reg continue)) 
      done)))

donald

  
 ;;b) 
  
 (define c-m 
   (make-machine '() 
                 (list (list 'null? null?) 
                       (list 'pair? pair?) 
                       (list '+ +) 
                       (list 'car car) 
                       (list 'cdr cdr)) 
                 '(controller 
                   (assign n (const 0)) 
                   (assign continue (label iter-done)) 
                    
                   iter 
                   (test (op null?) (reg tree)) 
                   (branch (label null-tree)) 
                   (test (op pair?) (reg tree)) 
                   (branch (label pair-tree)) 
                   (assign n (op +) (reg n) (const 1)) 
                   (goto (reg continue)) 
  
                   null-tree 
                   (goto (reg continue)) 
  
                   pair-tree 
                   (save continue) 
                   (save tree) 
                   (assign tree (op car) (reg tree)) 
                   (assign continue (label after-left-tree)) 
                   (goto (label iter)) 
  
                   after-left-tree 
                   (restore tree) 
                   (assign tree (op cdr) (reg tree)) 
                   (assign continue (label after-right-tree)) 
                   (goto (label iter)) 
  
                   after-right-tree 
                   (restore continue) 
                   (goto (reg continue)) 
  
                   iter-done)))

revc



(define count-leaves-machine
  (make-machine
   '(continue counter aux tree)
   (list (list 'null? null?)
         (list 'integer? integer?)
         (list 'symbol? symbol?)
         (list '+ +)
         (list 'car car)
         (list 'cdr cdr))

   '(
     (assign continue (label cl-done))
     cl-loop
     (test (op null?) (reg tree))
     (branch (label null-case))
     (test (op integer?) (reg tree))
     (branch (label atom-case))
     (test (op symbol?) (reg tree))
     (branch (label atom-case))

     (save continue)
     (save tree)
     (assign continue (label after-cl-1))
     (assign tree (op car) (reg tree))
     (goto (label cl-loop))

     after-cl-1
     (restore tree)
     (assign tree (op cdr) (reg tree))
     (save counter)
     (assign continue (label after-cl-2))
     (goto (label cl-loop))

     after-cl-2
     (restore aux)
     (assign counter (op +) (reg counter) (reg aux))

     (restore continue)
     (goto (reg continue))

     null-case
     (assign counter (const 0))
     (goto (reg continue))

     atom-case
     (assign counter (const 1))
     (goto (reg continue))

     cl-done
     )))

(set-register-contents! count-leaves-machine 'tree '(1 (3 4) 5 (6 (7 3) 9)))
(start count-leaves-machine)
(printf "~a~%" (get-register-contents count-leaves-machine 'counter))

(define count-leaves-machine
  (make-machine
   '(n tree source-tree continue)
   (list (list 'null? null?)
         (list 'integer? integer?)
         (list 'symbol? symbol?)
         (list '+ +)
         (list 'car car)
         (list 'cdr cdr))
   '(
     (assign continue (label cl-done))

     (assign tree (reg source-tree))
     (assign n (const 0))

     cl-loop
     (test (op null?) (reg tree))
     (branch (label null-case))
     (test (op integer?) (reg tree))
     (branch (label atom-case))
     (test (op symbol?) (reg tree))
     (branch (label atom-case))

     (save continue)
     (save tree)
     (assign continue (label after-cl-1))
     (assign tree (op cdr) (reg tree))
     (goto (label cl-loop))

     after-cl-1
     (restore tree)
     (assign tree (op car) (reg tree))
     (assign continue (label after-cl-2))
     (goto (label cl-loop))

     after-cl-2
     (restore continue)
     (goto (reg continue))

     null-case
     (goto (reg continue))

     atom-case
     (assign n (op +) (reg n) (const 1))
     (goto (reg continue))

     cl-done
     )))

(set-register-contents! count-leaves-machine 'source-tree '(1 (3 4) 5 (6 (7 3) 9)))
(start count-leaves-machine)
(printf "~a~%" (get-register-contents count-leaves-machine 'n))