SICP 読み (302) 5.4 積極制御評価器

なんか今年も残り少なくなってきた。残り 1 節ですが終了にはほど遠い。読了ベースで良いのであれば間に合わないこともないのでしょうが、この辺はあまり気にせず進めましょうね。

問題 5.30 の b.

昨晩は各方面に感謝を意を表しつつ力尽きました。又の名を現実トウヒと言うのだろうか。(こら
# しかもその後、iKnow にもニゲてたり (を
(300) なエントリを見つつ、検討。

続き

ささっと car と cdr だけ盛り込んでみた。ch5-eceval.scm の primitive-apply

primitive-apply
  (assign val (op apply-primitive-procedure)
              (reg proc)
              (reg argl))
  (test (op eq?) (reg val) (const pair-required))
  (branch (label signal-error))
  (restore continue)
  (goto (reg continue))

あと、eceval-operations も以下 (一部のみ)

(define eceval-operations
  (list
   ;;primitive Scheme operations
   (list 'read read)
   (list 'eq? eq?)

あるいは、ch5-eceval-support.scm の修正、追加分を以下に

(define (primitive-procedure-objects)
  (map (lambda (proc) (list 'primitive (car proc) (cadr proc)))
       primitive-procedures))

(define (primitive-implementation proc) (caddr proc))
(define (primitive-procedure-name proc) (cadr proc))

(define (apply-primitive-procedure proc args)
  (let ((ret (check-args (primitive-procedure-name proc) args)))
    (if (null? ret)
	(apply-in-underlying-scheme
	 (primitive-implementation proc) args)
	(car ret))))

(define (check-args proc-name args)
  (cond ((or (eq? proc-name 'car)
	     (eq? proc-name 'cdr))
	 (cond ((not (pair? (car args))) (list 'pair-required))
	       ((not (= 1 (length args))) (list 'wrong-number-argiments))
	       (else
		'())))
	(else
	 '())))

微妙。一応

;;; EC-Eval input:
(car '(1 2) '(3 4))

(total-pushes = 8 maximum-depth = 5)
;;; EC-Eval value:
wrong-number-argiments

;;; EC-Eval input:
(car 1)
pair-required

;;; EC-Eval input:
(cdr 1)
pair-required

;;; EC-Eval input:
(cdr '(1 2) 3)

(total-pushes = 8 maximum-depth = 5)
;;; EC-Eval value:
wrong-number-argiments

;;; EC-Eval input:
(car '(1 2))

(total-pushes = 5 maximum-depth = 3)
;;; EC-Eval value:
1

;;; EC-Eval input:
(cdr '(1 2))

(total-pushes = 5 maximum-depth = 3)
;;; EC-Eval value:
(2)

;;; EC-Eval input:

みたいなカンジで掴まえることができては、います。なんかテキトーでスミマセン。