4.16 の内部 define を let 化するやつが解けなくて困る

sicp

追記2

循環参照ではなくて、lambda が env を束縛してるだけだった。
前に進んで、今度は apply が問題になるところまで前進。
apply の中で compound-procedure 扱いになって、eval-sequence で死ぬ。


死んでしまうのはしょうがないので考察だけにしておこう。

(define (scan lst body defs)
  (cond ((null? lst)
         (cons (reverse body) (reverse defs)))
        ((null? (cdr lst))
         (scan '() (cons (car lst) body) defs))
        ((definition? (car lst))
         (scan (cdr lst)
               body
               (cons (cons (definition-variable (car lst))
                           (definition-value (car lst)))
                     defs)))
        (else
         (scan (cdr lst)
               (cons (car lst) body)
               defs))))

(define (scan-out-defines exp)
  (let ((lst (scan exp '() '())))
    (let ((body (car lst))
          (def-names (map car (cdr lst)))
          (def-bodies (map cdr (cdr lst))))
      (if (null? def-names)
          body
          (append
           (list 'let
                 (map (lambda (name) (list name '*unassigned*)) def-names))
           (append
            (map (lambda (name body) (list 'set! name body)) def-names def-bodies)
            body))))))
;; make-procedure は lambda 式にだけ適用されるみたい。
;; define は値としての lambda 式を持つようになるから、define された式の内部 define だけが対象になる
;; procedure-body は eval-sequence の全てに適用される。
;; なので、効率という意味では make-procedure に組み込むのがよい。

追記

env の中身が循環参照になってしまっている模様。
どこで道を間違えたのだろうか...

前のもの

SICP はまり中。

自分の書いたやつだとどうにもならなかったので、id:yad-EL さんのやつカンニングしたりした。
問題4.16 - ヤドカリ自習室（第二倉庫） - sicp

(define (scan lst body defs)
  (cond ((null? lst)
         (cons body defs))
        ((not (pair? lst))
         (scan '() (cons lst body) defs))
        ((definition? (car lst))
         (scan (cdr lst)
               body
               (cons (cons (definition-variable (car lst))
                           (definition-value (car lst)))
                     defs)))
        (else
         (scan (cdr lst)
               (cons (car lst) body)
               defs))))

(define (scan-out-defines exp)
  (let ((lst (scan exp '() '())))
    (let ((body (car lst))
          (def-names (map car (cdr lst)))
          (def-bodies (map cdr (cdr lst))))
      (if (null? def-names)
          body
          (append
           (list
            'let
            (map (lambda (name) (cons name '*unassigned*)) def-names))
           (map (lambda (name body) (list 'set! name body)) def-names def-bodies)
           body)))))

(define (make-procedure parameters body env)
  (list 'procedure parameters (scan-out-defines body) env))

scan-out-defines 自体をホスト言語で評価するとよさそうなのに

gosh> (scan-out-defines '((define b (cons 1 y)) (cons (b) x)))
((let ((b . *unassigned*)) (set! b (cons 1 y)) (cons (b) x)))

実装した超循環評価器で評価すると死んでしまう。
なんかずれてるんだろうなぁ。

gosh> (driver-loop)


;;; M-Eval input:
(define (a x y) (define b (cons 1 y)) (cons (b) x))

;;; M-Eval value:
ok

;;; M-Eval input:
(a 2 3)
*** ERROR: Too many arguments supplied (x y) (#f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<subr list>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr />) (primitive #<subr display>) (primitive #<subr newline>))
Stack Trace:
_______________________________________
  0  (extend-environment (procedure-parameters procedure) arguments (pr ...
        At line 12 of "./chapter4.scm"
  1  (eval (operator exp) env)
        At line 34 of "./chapter4.scm"
  2  (eval (operator exp) env)
        At line 34 of "./chapter4.scm"
  3  (eval (first-exp exps) env)
        At line 59 of "./chapter4.scm"
  4  (eval input the-global-environment)
        At line 357 of "./chapter4.scm"