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

引き続き、parse とか unparse とかをナニ。とりあえず試験書いた。

(use gauche.test)

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

(test-start "parse")
(test-section "unparse-expression")
(test* "unparse (1)"
       'a
       (unparse-expression '(var-exp a)))
(test* "unparse (2)"
       '(lambda (x) x)
       (unparse-expression '(lambda-exp x (var-exp x))))
(test* "unparse (3)"
       '((lambda (x) x) a)
       (unparse-expression '(app-exp (lambda-exp x (var-exp x)) (var-exp a))))

(test-section "parse-expression")
(test* "parse (1)"
       '(var-exp a)
       (parse-expression 'a))
(test* "parse (2)"
       '(lambda-exp x (var-exp x))
       (parse-expression '(lambda (x) x)))
(test* "parse (3)"
       '(app-exp (lambda-exp x (var-exp x)) (var-exp a))
       (parse-expression '((lambda (x) x) a)))
(test* "parse (4)"
       *test-error*
       (parse-expression 5))

(test-end)

以下な実装で、というのは On Lisp で書いてある_小規模で機敏な_ソレなのだろうな、と。

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

(define unparse-expression
  (lambda (exp)
    (cases expression exp
	   (var-exp (id) id)
	   (lambda-exp (id body)
		       (list 'lambda (list id)
			     (unparse-expression body)))
	   (app-exp (rator rand)
		    (list (unparse-expression rator)
			  (unparse-expression rand))))))

(define parse-expression
  (lambda (datum)
    (cond
     ((symbol? datum) (var-exp datum))
     ((pair? datum)
      (if (eqv? (car datum) 'lambda)
	  (lambda-exp (caadr datum)
		      (parse-expression (caddr datum)))
	  (app-exp
	   (parse-expression (car datum))
	   (parse-expression (cadr datum)))))
     (else
      (eopl:error 'parse-expression
		  "Invalid concrete symtax ~s" datum)))))

とりあえず Exercise 2.7 に着手してみます。

Exercise 2.7

まず expression.scm を以下に。

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

(define-datatype expression expression?
  (lit-exp
   (datum number?))
  (var-exp
   (id symbol?))
  (if-exp
   (test-exp expression?)
   (true-exp expression?)
   (false-exp expression?))
  (lambda-exp
   (id symbol?)
   (body expression?))
  (app-exp
   (rator expression?)
   (rand expression?)))

凄く直接的に書ける。試験書いてみる?
って全然違う試験が失敗。occurs-free? を以下に。

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

(define occurs-free?
  (lambda (var exp)
    (cases expression exp
	   (lit-exp (num) #f)
	   (var-exp (id) (eqv? id var))
	   (if-exp (test-exp true-exp false-exp)
		   (or (occurs-free? test-exp)
		       (occurs-free? true-exp)
		       (occurs-free? false-exp)))
	   (lambda-exp (id body)
		       (and (not (eqv? id var))
			    (occurs-free? var body)))
	   (app-exp (rator rand)
		    (or (occurs-free? var rator)
			(occurs-free? var rand))))))

さらに parse.scm も分岐をナニする必要あり。

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

(define unparse-expression
  (lambda (exp)
    (cases expression exp
	   (lit-exp (num) num)
	   (var-exp (id) id)
	   (if-exp (test-exp true-exp false-exp)
		   (list 'if test-exp true-exp false-exp))
	   (lambda-exp (id body)
		       (list 'lambda (list id)
			     (unparse-expression body)))
	   (app-exp (rator rand)
		    (list (unparse-expression rator)
			  (unparse-expression rand))))))

(define parse-expression
  (lambda (datum)
    (cond
     ((number? datum) (lit-exp datum))
     ((symbol? datum) (var-exp datum))
     ((pair? datum)
      (cond ((eqv? (car datum) 'lambda)
	     (lambda-exp (caadr datum)
			 (parse-expression (caddr datum))))
	    ((eqv? (car datum) 'if)
	     (if-exp (cadr datum) (caddr datum) (cadddr datum)))
	    (else
	     (app-exp
	      (parse-expression (car datum))
	      (parse-expression (cadr datum))))))
     (else
      (eopl:error 'parse-expression
		  "Invalid concrete symtax ~s" datum)))))

試験が以下。

(use gauche.test)

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

(test-start "parse")
(test-section "unparse-expression")
(test* "unparse (1)"
       'a
       (unparse-expression '(var-exp a)))
(test* "unparse (2)"
       '(lambda (x) x)
       (unparse-expression '(lambda-exp x (var-exp x))))
(test* "unparse (3)"
       '((lambda (x) x) a)
       (unparse-expression '(app-exp (lambda-exp x (var-exp x)) (var-exp a))))

(test-section "parse-expression")
(test* "parse (1)"
       '(var-exp a)
       (parse-expression 'a))
(test* "parse (2)"
       '(lambda-exp x (var-exp x))
       (parse-expression '(lambda (x) x)))
(test* "parse (3)"
       '(app-exp (lambda-exp x (var-exp x)) (var-exp a))
       (parse-expression '((lambda (x) x) a)))
(test* "parse (4)"
       '(lit-exp 5)
       (parse-expression 5))
(test* "parse (5)"
       *test-error*
       (parse-expression "a"))

(test-end)

とりあえず parse と unparse はなんとかなってるんでしょうか。
lexical-address 関連はちょっとタイム。