日: 2014年1月24日

multirember-f

multiremver の定義は次のとおりだった。

(define multirember
  (lambda (a lat)
    (cond
      ((null? lat) (quote ()))
      ((eq? (car lat) a) (multirember a (cdr lat)))
      (else (cons (car lat) (multirember a (cdr lat)))))))

今度は multirember-f を書いてください、ときた。簡単だ。test? を引数にとって、上の定義の中の eq? を test? に、multirember を (multirember test?) に置き換えたものを返してやればいい。

(define multirember-f
  (lambda (test?)
    (lambda (a lat)
      (cond
        ((null? lat) (quote ()))
        ((test? (car lat) a) ((multirember-f test?) a (cdr lat)))
        (else (cons (car lat) ((multirember-f test?) a (cdr lat))))))))

(print ((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna)))

^o^ > gosh multirember-f.scm
(shrimp salad salad and)

multiremberT

ここで eq?-c が再登場する。この関数はアトム a を引数にとって「アトム x を引数にとって a 比較する関数」を返す関数だった。x を tuna と比較する関数 eq?-tuna は次のように書ける。

(define eq?-tuna (eq?-c 'tuna))

さて、今度は、この eq?-tuna のような関数とラットを引数にとって multirember と同じように動作する multiremberT を書け、ときた。大丈夫、たぶん書けるだろう。

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))

(define eq?-tuna (eq?-c 'tuna))

(define multiremberT
  (lambda (test? lat)
    (cond
      ((null? lat) (quote ()))
      ((test? (car lat)) (multiremberT test? (cdr lat)))
      (else (cons (car lat) (multiremberT test? (cdr lat)))))))

(print (multiremberT eq?-tuna '(shrimp salad tuna salad and tuna)))

実行結果：

^o^ > gosh multiremberT.scm
(shrimp salad salad and)

よかった、OKのようだ。

6章に出てきた value が再登場だ。value の定義は次のとおりだった（補助関数の定義は省略している）。

(define value
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      ((eq? (operator nexp) (quote e+))
        (o+ (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp))))
      ((eq? (operator nexp) (quote e*))
        (o* (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp))))
      (else
        (o^ (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp)))))))

4つある cond の質問と値のうち、最初のを別にすれば3つともよく似ている。違うのは演算子とそれに対応する関数だけだ。そこで、演算子（演算子はアトムであることに注意）から関数に変換する関数を書いてやれば、上の定義を簡単化することができる。
変換する関数 atom-to-function はこうだ。

(define atom-to-function
  (lambda (o)
    (cond
      ((eq? o (quote e+)) o+)
      ((eq? o (quote e*)) o*)
      (else o^))))

これを使って、簡単化した value はこうなる。補助関数も含めて全体を示す。

(use mymodule)

(define 1st-sub-exp
  (lambda (aexp)
    (car (cdr aexp))))

(define 2nd-sub-exp
  (lambda (aexp)
    (car (cdr (cdr aexp)))))

(define operator
  (lambda (aexp)
    (car aexp)))

(define atom-to-function
  (lambda (o)
    (cond
      ((eq? o (quote e+)) o+)
      ((eq? o (quote e*)) o*)
      (else o^))))

(define value
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      (else
        ((atom-to-function (operator nexp)) (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp)))))))

(print (value '(e+ 3 8)))
(print (value '(e+ (e* 3 6) (e^ 8 2))))

実行結果：

^o^ > gosh -I. value4.scm
11
82

うまくいった！