EoPL reading (119) 2.3 Representation Strategies for Data Types

とりあえず、鍛錬をこつこつ続ける事に。高等数学きちんとヤッてないので scheme 使って計算云々な役立て方をイメージするのが微妙なんでしょうか。
それは良いとして Ex. 2.24 ですが誤読していた模様?
procedual なナニで言うと以下なカンジ?

(define empty-subst
  (lambda ()
    (lambda (sym)
      sym)))

(define apply-subst
  (lambda (s i)
    (s i)))

(define extend-subst
  (lambda (i t s)
    (lambda (sym)
      (if (eqv? sym i)
	  t
	  (apply-subst s sym)))))

問題の記述によれば

(empty-subst) は which binds its argument to a variable term of its argument とあるので引数を var-term にして戻せば良い模様
apply-subst は which returns the value of symbol i in substitutions s とあるので s に i を渡せば良い?
extend-subst は symbol i is assciated with term t 以外は s と同様、みたいな記述なので単純に extend すれば良い

そのまま戻す、というあたりを誤読というかそもそも読み切れていなかった模様。なるほどこれだとオブジェクトがどーゆーモノかをイメージできますな。

試験書いた

以下。

(use gauche.test)

(add-load-path ".")
(load "substitution")

(test-start "substitution")
(test-section "empty-subst")
(test* "((empty-subst) 'a) returns a"
       'a
       ((empty-subst) 'a))

(test-section "apply-subst")
(test* "(apply-subst (empty-subst) 'a) returns a"
       'a
       (apply-subst (empty-subst) 'a))

(test-section "extend-subst")
(test* "(apply-subst (extend-subst 'a '(x y) (empty-subst)) 'a) returns '(x y)"
       '(x y)
       (apply-subst (extend-subst 'a '(x y) (empty-subst)) 'a))

(test* "(apply-subst (extend-subst 'a '(x y) (empty-subst)) 'b) returns b"
       'b
       (apply-subst (extend-subst 'a '(x y) (empty-subst)) 'b))

(test-end)

これを元にabstract syntax tree representation なソレを書いてみる。とりあえず。define-datatype.scm および term.scm を新たに作成したディレクトリにコピィ。
で、以下がでっち上がる。

(add-load-path ".")
(load "define-datatype")
(load "term")

(define-datatype substitution substitution?
  (empty-subst-rec)
  (extended-subst-rec
   (id symbol?)
   (term term?)
   (sub substitution?)))		 

(define empty-subst
  (lambda ()
    (empty-subst-rec)))

(define extend-subst
  (lambda (i t s)
    (extended-subst-rec i t s)))

(define apply-subst
  (lambda (s i)
    (cases substitution s
	   (empty-subst-rec ()
			    (var-term i))
	   (extended-subst-rec (id term sub)
			       (if (eqv? i id)
				   term
				   (apply-subst sub i))))))

直上の試験を若干改変。ちなみに define-datatype にて extended-subst_rec と定義してたお陰でハマりました。

(use gauche.test)

(add-load-path ".")
(load "substitution")

(test-start "substitution")
(test-section "empty-subst")
(test* "(empty-subst) returns (empty-subst-rec)"
       '(empty-subst-rec)
       (empty-subst))

(test-section "apply-subst")
(test* "(apply-subst (empty-subst) 'a) returns (var-term a)"
       '(var-term a)
       (apply-subst (empty-subst) 'a))

(test-section "extend-subst")
(test* "(apply-subst (extend-subst 'a  '(app-term ((var-term x) (var-term y))) (empty-subst)) 'a) returns '(app-term ((var-term x) (var-term y)))"
       '(app-term ((var-term x) (var-term y)))
       (apply-subst (extend-subst 'a '(app-term ((var-term x) (var-term y))) (empty-subst)) 'a))

(test* "(apply-subst (extend-subst 'a '(app-term ((var-term x) (var-term y))) (empty-subst)) 'b) returns (var-term b)"
       '(var-term b)
       (apply-subst (extend-subst 'a '(app-term ((var-term x) (var-term y))) (empty-subst)) 'b))

(test-end)

見にくい。ここまでできたらあとは楽ですな。app-term だったら中のリストに subst-in-term を適用するナニ。

(define subst-in-term
  (lambda (t s)
    (cases term t
	   (var-term (id) (apply-subst s id))
	   (constant-term (datum) (constant-term datum))
	   (app-term (terms)
		     (let f ((rslt '()) (terms terms))
		       (if (null? terms)
			   (app-term rslt)
			   (f (append rslt (list (subst-in-term (car terms) s)))
			      (cdr terms))))))))

試験が以下。

(use gauche.test)

(add-load-path ".")
(load "substitution")

(test-start "subst-in-term")
(test-section "subst-in-term")
(test* "(subst-in-term (constant-term 1) (empty-subst)) returns"
       '(constant-term 1)
       (subst-in-term '(constant-term 1) (empty-subst)))

(test* "(subst-in-term (var-term a) (empty-subst)) returns"
       '(var-term a)
       (subst-in-term '(var-term a) (empty-subst)))

(test* "(subst-in-term (app-term ((var-term a) (var-term b))) (empty-subst)) returns"
       '(app-term ((var-term a) (var-term b)))
       (subst-in-term '(app-term ((var-term a) (var-term b))) (empty-subst)))

(test* "(subst-in-term (app-term ((var-term a) (var-term b))) (extend-subst 'a '(var-term z) (empty-subst))) returns"
       '(app-term ((var-term z) (var-term b)))
       (subst-in-term '(app-term ((var-term a) (var-term b))) 
		      (extend-subst 'a '(var-term z) (empty-subst))))

(test-end)

若干試験が足りてない気がしますがスルー。subst-in-terms はリキが残ってれば、という事にて。