SICP 問題 5.36

本文の被演算子の適用順はoperandをreverseしてから連結していくので右から左になっている．
これを左から右に変更する．

;;; 最初のreverseをなくす
(define (construct-arglist operand-codes)
  (if (null? operand-codes)
      (make-instruction-sequence
       '() '(argl)
       `((assign argl (const ()))))
      (let ((code-to-get-last-arg
             (append-instruction-sequences
              (car operand-codes)
              (make-instruction-sequence
               '(val) '(argl)
               `((assign argl (op list) (reg val)))))))
        (if (null? (cdr operand-codes))
            code-to-get-last-arg
            (preserving
             '(env)
             code-to-get-last-arg
             (code-to-get-rest-args
              (cdr operand-codes)))))))

(define (code-to-get-rest-args operand-codes)
  (let ((code-for-next-arg
         (preserving
          '(argl)
          (car operand-codes)
          (make-instruction-sequence
           '(val argl) '(argl)
           '((assign val (op list) (reg val)) ;valをリスト化する
             (assign argl
                     (op append) (reg argl) (reg val))))))) ;appendで順番通りにつなげる
    (if (null? (cdr operand-codes))
        code-for-next-arg
        (preserving
         '(env)
         code-for-next-arg
         (code-to-get-rest-args (cdr operand-cods))))))

問題5.35で求めた式をコンパイルしてみる．

(compile
 '(define (f x)
    (+ x (g (+ x 2))))
 'val 'next)


((env)
 (val)
 ((assign val (op make-compiled-procedure) (label entry23) (reg env))
  (goto (label after-lambda24))
  entry23
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (x)) (reg argl) (reg env))
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (save continue)
  (save proc)
  (assign val (op lookup-variable-value) (const x) (reg env)) ;元はgからだった
  (assign argl (op list) (reg val))
  (save argl)
  (assign proc (op lookup-variable-value) (const g) (reg env)) ;次の(g ...)にいく．
  (save proc)
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (assign val (op lookup-variable-value) (const x) (reg env)) ;左の引数のxから
  (assign argl (op list) (reg val))
  (assign val (const 2))                ;次に2
  (assign val (op list) (reg val))
  (assign argl (op append) (reg argl) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch25))
  compiled-branch26
  (assign continue (label after-call27))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch25
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  after-call27
  (assign argl (op list) (reg val))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch28))
  compiled-branch29
  (assign continue (label after-call30))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch28
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  after-call30
  (restore argl)
  (assign val (op list) (reg val))
  (assign argl (op append) (reg argl) (reg val))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch31))
  compiled-branch32
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch31
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
  after-call33
  after-lambda24
  (perform (op define-variable!) (const f) (reg val) (reg env))
  (assign val (const ok))
  ))

appendは一つ目のリストの末尾まで辿ってから後ろにリストをつなげていくので非効率になる．
よってこの場合効率を考えるなら右から左に評価するほうがよい．