SICP 読み (338) 5.5 翻訳系

なんかマルチになってしまってるので微妙。SICP 優先でナニするようにせねば、と思いつつ体がそう動かんのは終わりが来るのが嫌なのでしょうか。(違
ぐだぐだ言わず頑張ってみよう、な週末。

問題 5.40

問題 5.41 に例示されているソレで_compile-time environment_がイメージできる。まず、_compile とそれぞれのコード生成器に翻訳時環境の引数を加え_てみよう。

(define (compile exp target linkage cenv)
  (cond ((self-evaluating? exp)
         (compile-self-evaluating exp target linkage))
        ((quoted? exp) (compile-quoted exp target linkage))
        ((variable? exp)
         (compile-variable exp target linkage cenv))
        ((assignment? exp)
         (compile-assignment exp target linkage cenv))
        ((definition? exp)
         (compile-definition exp target linkage cenv))
        ((if? exp) (compile-if exp target linkage cenv))
        ((lambda? exp) (compile-lambda exp target linkage cenv))
        ((begin? exp)
         (compile-sequence (begin-actions exp)
                           target
                           linkage
			   cenv))
        ((cond? exp) (compile (cond->if exp) target linkage cenv))
        ((application? exp)
         (compile-application exp target linkage cenv))
        (else
         (error "Unknown expression type -- COMPILE" exp))))

cenv って名前が微妙。それは良いのですが変数を参照しないと思われる方々には渡さなくて良い、と見てるんですが駄目かなぁ。
この設問では具体的に翻訳手続きの中で何かをせえ、という訳ではないのでアレですが、とりあえず compile-lambda-body は手を加えないと駄目な模様。って cenv を拡張って以下なソレで良いのだろうか。

(define (compile-lambda-body exp proc-entry cenv)
  (let ((formals (lambda-parameters exp)))
    (append-instruction-sequences
     (make-instruction-sequence '(env proc argl) '(env)
      `(,proc-entry
        (assign env (op compiled-procedure-env) (reg proc))
        (assign env
                (op extend-environment)
                (const ,formals)
                (reg argl)
                (reg env))))
     (compile-sequence (lambda-body exp) 'val 'return (cons formals cenv)))))

これは compile-sequence も書き換え必要だな。とりあえず試験側でナニできると見て無理矢理作ってみます。方針としては cenv な引数が追加された手続きは試験側で cenv を戻すスタブとして書いてやれば大丈夫と見てるんですがどうだろう。
あ、compile-lambda はちょっと違うかな。以下に試験を。

(use gauche.test)

(add-load-path ".")
(load "5.40.scm")

(define (compile-variable a b c cenv)
  cenv)
(define (compile-assignment a b c cenv)
  cenv)
(define (compile-definition a b c cenv)
  cenv)
(define (compile-if a b c cenv)
  cenv)
(define (compile-sequence a b c cenv)
  cenv)
(define (compile-application a b c cenv)
  cenv)
(define (compile-lambda a b c cenv)
  (compile-lambda-body a b cenv))
(define (compile-lambda-body exp b cenv)
  (let ((formals (lambda-parameters exp)))
    (compile-sequence (lambda-body exp) 'val 'return (cons formals cenv))))

(test-start "5.40")

(test-section "variable")
(test* "check cenv" '() (compile 'x 'val 'return '()))
(test* "check cenv" '((x y)) (compile 'x 'val 'return '((x y))))
(test* "check cenv" '((a b c d e) (x y)) (compile 'x 'val 'return '((a b c d e) (x y))))

(test-section "assignment")
(test* "check cenv" '() (compile '(set! x 1) 'val 'return '()))
(test* "check cenv" '((x y)) (compile '(set! x 1) 'val 'return '((x y))))
(test* "check cenv" '((a b c d e) (x y)) (compile '(set! x 1) 'val 'return '((a b c d e) (x y))))

(test-section "definition")
(test* "check cenv" '() (compile '(define x 1) 'val 'return '()))
(test* "check cenv" '((x y)) (compile '(define x 1) 'val 'return '((x y))))
(test* "check cenv" '((a b c d e) (x y)) (compile '(define x 1) 'val 'return '((a b c d e) (x y))))

(test-section "if")
(test* "check cenv" '() (compile '(if (= n 1) 1 2) 'val 'return '()))
(test* "check cenv" '((x y)) (compile '(if (= n 1) 1 2) 'val 'return '((x y))))
(test* "check cenv" '((a b c d e) (x y)) (compile '(if (= n 1) 1 2) 'val 'return '((a b c d e) (x y))))

(test-section "cond")
(test* "check cenv" '() (compile '(cond ((= n 1) 1)) 'val 'return '()))
(test* "check cenv" '((x y)) (compile '(cond ((= n 1) 1)) 'val 'return '((x y))))
(test* "check cenv" '((a b c d e) (x y)) (compile '(cond ((= n 1) 1)) 'val 'return '((a b c d e) (x y))))

(test-section "seq")
(test* "check cenv" '() (compile '(begin (+ x 1)) 'val 'return '()))
(test* "check cenv" '((x y)) (compile '(begin (+ x 1)) 'val 'return '((x y))))
(test* "check cenv" '((a b c d e) (x y)) (compile '(begin (+ x 1)) 'val 'return '((a b c d e) (x y))))

(test-section "app")
(test* "check cenv" '() (compile '(+ x 1) 'val 'return '()))
(test* "check cenv" '((x y)) (compile '(+ x 1) 'val 'return '((x y))))
(test* "check cenv" '((a b c d e) (x y)) (compile '(+ x 1) 'val 'return '((a b c d e) (x y))))

(test-section "lambda")
(test* "check cenv" '((y z)) (compile '(lambda (y z) (+ x 1)) 'val 'return '()))
(test* "check cenv" '((y z) (x y)) (compile '(lambda (y z) (+ x 1)) 'val 'return '((x y))))
(test* "check cenv" '((y z) (a b c d e) (x y)) (compile '(lambda (y z) (+ x 1)) 'val 'return '((a b c d e) (x y))))

(test-end)

一応試験しながら作ったんですが、こんなテスツで良いのでしょうか。

問題 5.41

イキオイで find-variable も作ってみる。

(define (find-variable var cenv)
  )

なカタチですが中身はどうしたものか。あ、まず試験か。

(use gauche.test)

(add-load-path ".")
(load "5.41.scm")

(test-start "5.41")
(let ((env '((y z) (a b c d e) (x y))))
  (test* "part1" '(1 2) (find-variable 'c env)) 
  (test* "part2" '(2 0) (find-variable 'x env))
  (test* "part3" 'not-found (find-variable 'w env)))

(test-end)

このあたりは単発なナニなので話が早いな。本体をどうしたものか。

(define (fine-variable var env)
  (define (f-search i env)
    (define (lexical-add-out j l)
      (cond ((null? l) (f-search (+ i 1) (cdr env)))
	    ((eq? var (car l)) (list i j))
	    (else
	     (lexical-add-out (+ j 1) (cdr l)))))
    (if (null? env)
	'not-found
	(lexical-add-out 0 (car env))))
  (f-search 0 env))

あら、できちゃった??
作るまでの過程を記録しようと思ってたんですが、できんかったよ。でも内側から作ったな。理由は不明。しかも上記が動くかどうかは知らん。(何

続

ぢつは借りてきた_かもめ食堂_見ながら作ってたり。酒も呑んでるし。一応上記で試験はパスしている模様。いいんだろうか。