EoPL reading (112) 2.3 Representation Strategies for Data Types
Exercise 2.21
検討前に思わず手が動いた。
$ gosh gosh> (cons '(() ()) '()) ((() ())) gosh>
これはこれは。しかも問題解いてない (とほほ
Exercise 2.22 の前に
例示されてる手続きをナニ。これはおそらく SICP で出てくる環境モデルなはず。
(define empty-env
(lambda () '()))
(define extend-env
(lambda (syms vals env)
(cons (list syms vals) env)))
(define apply-env
(lambda (env sym)
(if (null? env)
(eopl:error 'apply-env
"No binding for " sym)
(let ((syms (car (car env)))
(vals (cadr (car env)))
(env (cdr env)))
(let ((pos (list-find-position sym syms)))
(if (number? pos)
(list-ref vals pos)
(apply-env env sym)))))))
(define list-find-position
(lambda (sym los)
(list-index (lambda (sym1) (eqv? sym1 sym)) los)))
(define list-index
(lambda (pred ls)
(cond ((null? ls) #f)
((pred (car ls)) 0)
(else
(let ((list-index-r (list-index pred (cdr ls))))
(if (number? list-index-r)
(+ list-index-r 1)
#f))))))今から試験を検討。ってか Exercise 2.20 な試験を使いました。基本的な試験を追加して以下。
(use gauche.test)
(add-load-path ".")
(load "env")
(test-start "extend-env")
(test-section "empty-env")
(test* "empty env is '()"
'()
(empty-env))
(test-section "extend-env")
(test* "(extend-env '() '() (empty-env))"
'((() ()))
(extend-env '() '() (empty-env)))
(test* "(extend-env '(a) '(1) (empty-env))"
'(((a) (1)))
(extend-env '(a) '(1) (empty-env)))
(test* "(extend-env '(d x) '(6 7)
(extend-env '(y) '(8)
(empty-env)))"
'(((d x) (6 7)) ((y) (8)))
(extend-env '(d x) '(6 7)
(extend-env '(y) '(8)
(empty-env))))
(test-section "abnormal end")
(test* "apply empty-env"
*test-error*
(apply-env (empty-env) 'a))
(test* "search 'a from '(b c)"
*test-error*
(apply-env (extend-env '(b c) '(0 1) (empty-env))
'a))
(test* "search 'z from '((a) (b c))"
*test-error*
(apply-env (extend-env '(a) '(0)
(extend-env '(b c) '(1 2) (empty-env)))
'z))
(test-section "normal end")
(test* "search 'a from '(a b)"
0
(apply-env (extend-env '(a b) '(0 1) (empty-env))
'a))
(test* "search 'b from '(a b)"
1
(apply-env (extend-env '(a b) '(0 1) (empty-env))
'b))
(test* "search 'c from '((a b) (c))"
2
(apply-env (extend-env '(a b) '(0 1)
(extend-env '(c) '(2) (empty-env)))
'c))
(test-end)一応試験にはパスしています。これ式を ribcage な表現と呼ぶらしい。リストのリストが ribs との事。その後、list->vector 使ったりとか lexical address なナニがあるんですが、このあたりは現実トウヒなネタとして取っとく事に。
Exercise 2.22
Figure 2.4 を scheme 手続きで書いてみると以下?
(cons (cons (list 'x 'c) (vector 66 77)) '())
さらに
(cons (cons (list 'a 'b 'c) (vector 11 22 33))
(cons (cons (list 'x 'c) (vector 66 77))
'()))で良いのかなぁ。てーコトは extend-env は以下?
(define extend-env
(lambda (syms vals env)
(cons (cons syms (list->vector vals)) env)))本当は試験から書くべきなんでしょうが相当に疲れてます。最終的に以下がでっち上がりました。* 一つなので eazy?
(define empty-env
(lambda () '()))
(define extend-env
(lambda (syms vals env)
(cons (cons syms (list->vector vals)) env)))
(define apply-env
(lambda (env sym)
(if (null? env)
(eopl:error 'apply-env
"No binding for " sym)
(let ((syms (car (car env)))
(vals (cdr (car env)))
(env (cdr env)))
(let ((pos (list-find-position sym syms)))
(if (number? pos)
(vector-ref vals pos)
(apply-env env sym)))))))
(define list-find-position
(lambda (sym los)
(list-index (lambda (sym1) (eqv? sym1 sym)) los)))
(define list-index
(lambda (pred ls)
(cond ((null? ls) #f)
((pred (car ls)) 0)
(else
(let ((list-index-r (list-index pred (cdr ls))))
(if (number? list-index-r)
(+ list-index-r 1)
#f))))))で、vector なのと cons なのを忘れてたんですが、失敗分を盛り込んだ試験が以下。
(use gauche.test)
(add-load-path ".")
(load "env")
(test-start "extend-env")
(test-section "empty-env")
(test* "empty env is '()"
'()
(empty-env))
(test-section "extend-env")
(test* "(extend-env '() '() (empty-env))"
'((() . #()))
(extend-env '() '() (empty-env)))
(test* "(extend-env '(a) '(1) (empty-env))"
'(((a) . #(1)))
(extend-env '(a) '(1) (empty-env)))
(test* "(extend-env '(d x) '(6 7)
(extend-env '(y) '(8)
(empty-env)))"
'(((d x) . #(6 7)) ((y) . #(8)))
(extend-env '(d x) '(6 7)
(extend-env '(y) '(8)
(empty-env))))
(test-section "abnormal end")
(test* "apply empty-env"
*test-error*
(apply-env (empty-env) 'a))
(test* "search 'a from '(b c)"
*test-error*
(apply-env (extend-env '(b c) '(0 1) (empty-env))
'a))
(test* "search 'z from '((a) (b c))"
*test-error*
(apply-env (extend-env '(a) '(0)
(extend-env '(b c) '(1 2) (empty-env)))
'z))
(test-section "normal end")
(test* "search 'a from '(a b)"
0
(apply-env (extend-env '(a b) '(0 1) (empty-env))
'a))
(test* "search 'b from '(a b)"
1
(apply-env (extend-env '(a b) '(0 1) (empty-env))
'b))
(test* "search 'c from '((a b) (c))"
2
(apply-env (extend-env '(a b) '(0 1)
(extend-env '(c) '(2) (empty-env)))
'c))
(test-end)次の問題が *ふたつ なんですが、ヤリ忘れてる大事な事を思いだしたので今日はこれで終了。
