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 関連はちょっとタイム。