[jfriends:00043] 問題 5.25 に関して

[sdfu@xxxxxxxxxxxxx]

鈴木です。
おひさしぶりです。

At Mon, 09 Dec 2002 10:23:54 +0900 (JST),
Eiiti Wada wrote:
> 
> 和田@IIJ技術研究所 です. 
> 
> >;; 問題 5.25
> >
> >;; 実引数を評価する前に、その頭すべてに eval を付けておく
> >
> >(foo (+ 1 2) (* 3 4))
> >      ~~~~~  ~~~~~~~
> >        3       12
> >
> >(define (foo x y)
> > (+ (* x x) (* y y))
> > ~~~~~~~~~~~~~~~~~~~
> >      x (eval (+ 1 2))
> >      y (eval (* 3 4))
> >
> >;; 宿題
> 
> やってみました. やはりthunkを実装する必要がありました. 

thunkを使わないで、primitiveな関数が呼ばれた時に
引数を評価するというのは駄目でしょうか？
引数を評価するコードをごそっとprimitive-apply
(下のコードではexec-primitive-applyという名前にしてあります。)
の前にもっていっています。


ev-application
  (save continue)
  (save env)
  (assign unev (op operands) (reg exp))
  (save unev)
  (assign exp (op operator) (reg exp))
  (assign continue (label ev-appl-did-operator))
  (goto (label eval-dispatch))
ev-appl-did-operator
  (restore unev)
  (restore env)
  (assign argl (op empty-arglist))
  (assign proc (reg val))
  (goto (label apply-dispatch))

apply-dispatch
  (test (op primitive-procedure?) (reg proc))
  (branch (label before-primitive-apply))             ;;EXERCISE 5.25
  (test (op compound-procedure?) (reg proc))  
  (branch (label compound-apply))
  (goto (label unknown-procedure-type))

;;EXERCISE 5.25
before-primitive-apply
  (test (op no-operands?) (reg unev))
  (branch (label exec-primitive-apply))
;;  (save proc)
ev-primappl-operand-loop
  (save argl)
  (assign exp (op first-operand) (reg unev))
  (test (op last-operand?) (reg unev))
  (branch (label ev-primappl-last-arg))
  (save env)
  (save unev)
  (assign continue (label ev-primappl-reeval))
  (goto (label eval-dispatch))
ev-primappl-reeval
  ;;評価されていないまま入っているので再評価
  (assign exp (reg val)) 
  (assign continue (label ev-primappl-accumulate-arg))
  (goto (label eval-dispatch))
ev-primappl-accumulate-arg
  (restore unev)
  (restore env)
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (assign unev (op rest-operands) (reg unev))
  (goto (label ev-primappl-operand-loop))
ev-primappl-last-arg
 (assign continue (label ev-primappl-accum-last-arg))
  (goto (label eval-dispatch))
ev-primappl-accum-last-arg
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
;;  (restore proc)
  (goto (label exec-primitive-apply))

exec-primitive-apply
  (assign val (op apply-primitive-procedure)
              (reg proc)
              (reg argl))
  (restore continue)
  (goto (reg continue))

compound-apply
  (assign argl (reg unev))
  (assign unev (op procedure-parameters) (reg proc))
  (assign env (op procedure-environment) (reg proc))
  (assign env (op extend-environment)
              (reg unev) (reg argl) (reg env))
  (assign unev (op procedure-body) (reg proc))
  (goto (label ev-sequence))