EoPL reading (111) 2.3 Representation Strategies for Data Types
Exercise 2.20
用件済んだので次の問題に着手。2.17 ではメッセージパッシングで云々してます。これがいっちゃん楽、っていう固定概念をステないと駄目な気がしますが、とりあえず実装してみます。
てか、先に試験を書く。
(use gauche.test) (add-load-path ".") (load "Fig2.3") (test-start "has-association?") (test* "(has-association? 'a (empty-env))" #f (has-association? (empty-env))) (test* "(has-association? 'a (((a b) (1 2))))" #t (has-association? 'a (extended-env-record '(a b) '(1 2) (empty-env)))) (test* "(has-association? 'z (((a b) (1 2))))" #f (has-association? 'z (extended-env-record '(a b) '(1 2) (empty-env)))) (test-end)
で、実装が以下。
(add-load-path ".") (load "define-datatype") (define scheme-value? (lambda (v) #t)) (define list-of (lambda (pred) (lambda (val) (or (null? val) (and (pair? val) (pred (car val)) ((list-of pred) (cdr val))))))) (define-datatype environment environment? (empty-env-record) (extended-env-record (syms (list-of symbol?)) (vals (list-of scheme-value?)) (env environment?))) (define empty-env (lambda () (empty-env-record))) (define extend-env (lambda (syms vals env) (extended-env-record syms vals env))) (define apply-env-inner (lambda (cmd env sym) (cases environment env (empty-env-record () (if (eqv? cmd 'pred) #f (eopl:error 'apply-env "No binding for" sym))) (extended-env-record (syms vals env) (let ((pos (list-find-position sym syms))) (if (number? pos) (list-ref vals pos) (apply-env-inner cmd env sym))))))) (define apply-env (lambda (env sym) (apply-env-inner 'apply env sym))) (define has-association? (lambda (env sym) (apply-env-inner 'pred 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))))))
ええと、has-association? の試験は以下でした。#t は戻ってこないんだよな、と。
(use gauche.test) (add-load-path ".") (load "Fig2.3") (test-start "has-association?") (test* "(has-association? (empty-env) 'a)" #f (has-association? (empty-env) 'a)) (test* "(has-association? (((a b) (1 2))) 'a)" #f (not (has-association? (extended-env-record '(a b) '(1 2) (empty-env)) 'a))) (test* "(has-association? (((a b) (1 2)) 'z))" #f (has-association? (extended-env-record '(a b) '(1 2) (empty-env)) 'z )) (test-end)
なんか微妙だなぁ。とりあえず 2.3.4 に進みます。