EoPL 読んでた記録の確認とその記録

scheme EoPL

コードを引用してるんだけど、これって GitHub あたりにあったりするのかなぁ。

確認してみたところ

無い。自分エントリをさらってみたところ、2009 年あたりにもごもごしている模様。2.2 節以降を再確認しつつ EoPL も再確認しつつ進めてみることに。
とりあえず

$ cd Public
$ mkdir EoPL
$ cd EoPL
$ git init

して define-datatype の実装云々ってあたりからナニ。

とりあえずこうするか。

$ mkdir define-datatype
$ cd define-datatype
$ wget http://www.cs.indiana.edu/eopl/code/interps/define-datatype.scm

つうか

かなりえんえんと define-datatype の試験を書いているなあ。以下あたりからマトモに練習問題に着手しているのかな。

このへんからサルベージしてみる方向。

Exercise 2.5

数えあげて云々な手法を採用してみることに。とりあえず数えあげを実装。

(define enumerate-interior-node
  (lambda (tree)
    (cases bintree tree
	   (leaf-node (datum) '())
	   (interior-node
	    (key left right)
	    (append (list tree)
		    (enumerate-interior-node left)
		    (enumerate-interior-node right))))))

この戻りを leaf-sum な map で filter すれば良いのかどうか。上記な手続きの試験として以下をでっち上げてます。一応パスしてますがどうなんだろ。

(test* "tree-a enum"
       (list tree-a)
       (enumerate-interior-node tree-a))
(test* "tree-b enum"
       (append (list tree-b) (list tree-a))
       (enumerate-interior-node tree-b))
(test* "tree-c enum"
       (append (list tree-c) (list tree-b) (list tree-a))
       (enumerate-interior-node tree-c))
(test* "tree-d enum"
       (list tree-d)
       (enumerate-interior-node tree-d))
(test* "tree-e enum"
       (append (list tree-e) (list tree-d) (list tree-c) (list tree-b) (list tree-a))
       (enumerate-interior-node tree-e))
(test* "tree-f enum"
       (list tree-f)
       (enumerate-interior-node tree-f))
(test* "tree-g enum"
       (append (list tree-g) (list tree-d) (list tree-f))
       (enumerate-interior-node tree-g))

以下なカンジ?

(define max-interior
  (lambda (tree)
    (let ((l (sort (map (lambda (x) (list (cadr x) (leaf-sum x)))
			(enumerate-interior-node tree))
		   (lambda (x y) (> (cadr x) (cadr y))))))
      (car (car l)))
    ))

随分 Scheme ぽいカンジになりました。既存の試験にもパスしてます。ちなみに sort に渡す比較手続きの比較演算子な手続きを逆に書いていたのは秘密。

やはり

SICP にある、enum - map - filter - accumulate なナニは無敵。

Exercise 2.6

以下のリストを abstract syntax tree に、とのことなんですが以下かな。

(app-exp (lambda-exp x (app-exp (var-exp  a) (var-exp b))) (var-exp c))

これって、と思ってたらすぐに unparse-expression と parse-expression てのが出てきました。成程。パーサは必要ですよね。
とは言えここ、ポイント高いな。スデに抽象表現である S 式なんだけれど、parse して abstract syntax tree にして評価して unparse して云々なのか。

Exercise 2.7

とりあえず Exercise 1.31 な lexical-address な実装のサルベイジ。以下なのかな。

(define (lexical-address exp)
  (define (lexical-address-inner rslt dict l)
    (cond ((null? l) rslt)
          ((symbol? l)
           (let f ((d 0) (p 0) (dict dict))
             (cond ((null? dict) `(,l free))
                   ((memq l (car dict))
                    (let f-inner ((p p) (dict (car dict)))
                      (if (eq? l (car dict))
                          `(,l : ,d ,p)
                          (f-inner (+ p 1) (cdr dict)))
                      ))
                   (else
                    (f (+ d 1) 0 (cdr dict))))))
          ((eqv? (car l) 'lambda)
           (lexical-address-inner (append rslt `(lambda ,(cadr l)))
                                  (cons (cadr l) dict) (cddr l)))
          ((eqv? (car l) 'if)
           (lexical-address-inner (append rslt '(if)) dict (cdr l)))
          (else
           (let g ((rslt rslt) (l l))
             (cond ((null? l) rslt)
                   (else
                    (g (append rslt (list (lexical-address-inner '() dict (car l))))
                       (cdr l)))))
           )
          )
    )
  (lexical-address-inner '() '() exp)
  )

なんか微妙。見直し必要ですね。試験はどこにある。以下なのかな。

(use gauche.test)

(add-load-path ".")
(load "lexical-address")

(test-start "lexical-address")
(test-section "lexical-address")
(test* "(lexical-address '()) should return '()"
       '()
       (lexical-address '()))

(test* "(lexical-address 'a) should return '(a free)"
       '(a free)
       (lexical-address 'a))

(test* "(lexical-address '(a)) should return '((a free))"
       '((a free))
       (lexical-address '(a)))

(test* "(lexical-address '(a b)) should return '((a free) (b free))"
       '((a free) (b free))
       (lexical-address '(a b)))

(test* "(lexical-address '(lambda (a b c) a)) should return '(lambda (a b c) (a : 0 0))"
       '(lambda (a b c) (a : 0 0))
       (lexical-address '(lambda (a b c) a)))

(test* "(lexical-address '(lambda (a b c) (a b c))) should return '(lambda (a b c) ((a : 0 0) (b : 0 1) (c : 0 2)))"
       '(lambda (a b c) ((a : 0 0) (b : 0 1) (c : 0 2)))
       (lexical-address '(lambda (a b c) (a b c))))

(test* "(lexical-address '(lambda (a b c)
                            (if (eqv? b c)
                              ((lambda (c)
                                 (cons a c))
                               a)
                              b)))
         should return
         (lambda (a b c)
           (if ((eqv? free) (b : 0 1) (c : 0 2))
             ((lambda (c)
                ((cons free) (a : 1 0) (c : 0 0)))
              (a : 0 0))
             (b : 0 1)))"
       '(lambda (a b c)
	  (if ((eqv? free) (b : 0 1) (c : 0 2))
	      ((lambda (c)
		 ((cons free) (a : 1 0) (c : 0 0)))
	       (a : 0 0))
	      (b : 0 1)))
       (lexical-address '(lambda (a b c)
			   (if (eqv? b c)
			       ((lambda (c)
				  (cons a c))
				a)
			       b))))

(test-end)

上記、手元に持ってきて実行したら試験パスしましたが今から見直し。つうかそろそろ今日はこれで仕舞う。