EoPL reading (74) 2.2 An Abstraction for Inductive Data Type

今日はばたばたしてて現実トウヒどころではありませんでした。ちょっとストレス溜まってる感満点なので検討着手。
で、手続きを書きはじめて気づいたのが Ex-1.19 の解は_まず app-exp 乃至 lambda-expが渡される_のがデフォな模様。って試験見たら基本 lambda になってますな。試験足りてない。
大体が free-symbol って手続きがある自体で微妙。これって 1.19 の出力はガン無視で一から考えた方が気持ち良さげな気がしてます。
で、無理矢理以下な実装をヒリ出して試験実行。最初は以下な形で逆をイッてました。あ、あと parse せずに書いてましたが、ソコはスルーで。

(add-load-path ".")
(load "define-datatype")
(load "expression")
(load "parse")

(define (free-vars l)
  (free-vars-test (parse-expression l)))

(define (free-vars-test l)
  (let f ((rslt '()) (arg '()) (l l))
    (cases expression l
	   (lit-exp (num) rslt)
	   (var-exp (id)
		    (let free-symbol ((l arg) (s id))
		      (cond ((null? l) rslt)
			    ((eq? (car l) s)
			     (append rslt (list s)))
			    (else
			     (free-symbol (cdr l) s)))))
	   (lambda-exp (ids body)
		       (f rslt (append arg ids) body))
	   (app-exp (rands)
		    (let app-exp-inner ((rslt rslt) (rands rands))
		      (if (null? rands)
			  rslt
			  (app-exp-inner (f rslt arg (car rands))
					 (cdr rands)))))
	   (else
	    rslt)
	   ))
	    
  )

あ、else の部分も今はスルーでお願いします。で、上記は微妙だったんで以下に修正。本体のみ、でご勘弁下さい。

(define (free-vars-test l)
  (let f ((rslt '()) (arg '()) (l l))
    (cases expression l
	   (lit-exp (num) rslt)
	   (var-exp (id)
		    (let free-symbol ((l arg) (s id))
		      (cond ((null? l)
			     (append rslt (list s)))
			    ((eq? (car l) s) rslt)
			    (else
			     (free-symbol (cdr l) s)))))
	   (lambda-exp (ids body)
		       (f rslt (append arg ids) body))
	   (app-exp (rands)
		    (let app-exp-inner ((rslt rslt) (rands rands))
		      (if (null? rands)
			  rslt
			  (app-exp-inner (f rslt arg (car rands))
					 (cdr rands)))))
	   (else
	    rslt)
	   ))
	    
  )

この時点で以下の試験に失敗。

test (free-vars '(lambda (x y) (x 1 2) ((y) 3 z)) should return (z): expects (z) => got ()
test (free-vars '(lambda (x) ()) should return (): expects () => got #<error "parse-expression \"Invalid concrete symtax ~s\" ()">

下側の試験は null-exp というオブジェクトが存在しないので無理。上側のは若干微妙。意味不明なので parse してみたら以下な出力。

$ gosh
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.13/lib")
gosh> (load "define-datatype")
#t
gosh> (load "expression")
#t
gosh> (load "parse")
#t
gosh> (parse-expression '(lambda (x y) (x 1 2) ((y) 3 z)))
(lambda-exp (x y) (app-exp ((var-exp x) (lit-exp 1) (lit-exp 2))))
gosh> 

なんだこれは。って、parse な手続きの中で body なリストの car しか相手にしてませんな。

      (cond ((eqv? (car datum) 'lambda)
	     (lambda-exp (cadr datum)
			 (parse-expression (caddr datum))))

ここは cddr じゃないと微妙。疲労困憊なので休みます。