sicp-ex-5.38



<< Previous exercise (5.37) | Index | Next exercise (5.39) >>


meteorgan

  
  
  
 (a) 
 ;; in compile 
 ((open-code? exp) (compile-open-code exp target linkage)) 
  
  (define (open-code? exp) 
     (memq (car exp) '(+ - * /))) 
  
 (define (spread-arguments operand1 operand2) 
  (let ((op1 (compile operand1 'arg1 'next)) 
            (op2 (compile operand2 'arg2 'next))) 
   (list op1 op2))) 
  
 (b) 
  
 ;; This procedure has a bug. It does not save the environment 
 ;; Around the compilation of the first arg. Becuase of this it 
 ;; will give incorrect results for recursive procedures. In my answer 
 ;; Below I have fixed this. 
 (define (compile-open-code exp target linkage) 
  (let ((op (car exp)) 
            (args (spread-arguments (cadr exp) (caddr exp)))) 
   (end-with-linkage linkage 
    (append-instruction-sequences 
         (car args) 
         (preserving '(arg1) 
          (cadr args) 
          (make-instruction-sequence '(arg1 arg2) (list target) 
           `((assign ,target (op ,op) (reg arg1) (reg arg2))))))))) 

Rptx

  
 ; (d) 
 ; these include the answer to 5.44 
  
 (define (compile-+ exp target linkage compile-time-environment) 
   (if (overwrite? (operator exp) 
                   compile-time-environment) 
       (compile-application exp target linkage compile-time-environment) 
       (let ((operands (operands exp))) 
         (if (< 2 (length operands)) 
             (compile (two-by-two '+ operands) target linkage compile-time-environment) 
             (let ((operands (spread-arguments operands compile-time-environment))) 
               (end-with-linkage 
                linkage 
                (preserving 
                 '(env continue) 
                 operands 
                 (make-instruction-sequence 
                  '(arg1 arg2) (list target) 
                  `((assign ,target (op +) (reg arg1) (reg arg2))))))))))) 
  
 (define (compile-* exp target linkage compile-time-environment) 
   (if (overwrite? (operator exp) 
                   compile-time-environment) 
       (compile-application exp target linkage compile-time-environment) 
    (let ((operands (operands exp))) 
      (if (< 2 (length operans)) 
          (compile  
           (two-by-two '* operands) target linkage compile-time-environment) 
          (let ((operands (spread-arguments operands compile-time-environment))) 
            (end-with-linkage 
             linkage 
             (preserving 
              '(env continue) 
              operands 
              (make-instruction-sequence 
               '(arg1 arg2) (list target) 
               `((assign ,target (op *) (reg arg1) (reg arg2))))))))))) 
  
 (define (-? exp) 
   (tagged-list? exp '-)) 
 (define (compile-- exp target linkage compile-time-environment) 
   (let ((operands (spread-arguments (operands exp) compile-time-environment))) 
     (end-with-linkage 
      linkage 
      (preserving 
       '(env continue) 
       operands 
       (make-instruction-sequence 
        '(arg1 arg2) (list target) 
        `((assign ,target (op -) (reg arg1) (reg arg2)))))))) 
  
 (define (/? exp) 
   (tagged-list? exp '/)) 
 (define (compile-/ exp target linkage compile-time-environment) 
   (let ((operands (spread-arguments (operands exp) compile-time-environment))) 
     (end-with-linkage 
      linkage 
      (preserving 
       '(env continue) 
       operands 
       (make-instruction-sequence 
        '(arg1 arg2) (list target) 
        `((assign ,target (op /) (reg arg1) (reg arg2)))))))) 
  
 (define (two-by-two proc operands) 
   (if (> 2 (length operands)) 
       (car operands) 
       (list proc (car operands) 
             (two-by-two proc (cdr operands)))))