htmlに変換 - 初学者の箸置

いまごろなんだけど吉田裕美さんの記事を見てて、
http://www.thinkit.co.jp/article/74/2/2.html

  (html
    (head (title "Gauche Web"))
    (body (h1 "Gauche Web Page")
	  (table (tr (td "1") (td "lisp"))
		 (tr (td "2") (td "scheme"))))))

こんなS式をhtmlに変換するとかいうのがちょうど僕のリハビリがてらにナイスサイズだったので食べてみた。
evalしてREPLに食わせようとか甘いことを考えて

(define (print-html e)
  (define html
    (wrap-element "<html>" "</html>"))
  (define head
    (wrap-element "<head>" "</head>"))
  (define title
    (wrap-element "<title>" "</title>"))
  (define body
    (wrap-element "<body>" "</body>"))
  (define h1
    (wrap-element "<h1>" "</h1>"))
  (define table
    (wrap-element "<table>" "</table>"))
  (define td
    (wrap-element "<td>" "</td>"))
  (define tr
    (wrap-element "<tr>" "</tr>"))
  (define td
    (wrap-element "<td>" "</td>"))

  (define env (interaction-environment))

  (define (wrap-element pre post)
    (lambda body
      (string-append pre 
		     (fold-right string-append ""
			   (map (lambda (elem) (eval elem env))
				body))
		     post)))

  (print (eval e env)))

(define sample-html 
  '(html
    (head (title "Gauche Web"))
    (body (h1 "Gauche Web Page")
	  (table (tr (td "1") (td "lisp"))
		 (tr (td "2") (td "scheme"))))))

(print-html sample-html)

とかやってみる。が、見事に撃沈。

gosh> *** ERROR: unbound variable: title
Stack Trace:
_______________________________________
  0  (title "Gauche Web")

ぐわっ。というわけで検索。
"Gauche:evalと環境"
そうか、evalのenvironmentっていまいち謎ながら無視してたけど、Gauche実装ではレキシカルスコープまでは入らないトップレベルなんだね。すこし勉強になりますた。

define-moduleにてモジュールを作ってトップレベルを変更すればいいみたい。

(define-module html-module)
(define env (find-module 'html-module))

(with-module html-module
	     (define (wrap-element pre post)
	       (lambda body
		 (string-append 
		  pre 
		  (fold-right string-append ""
			(map (lambda (elem) 
			       (eval elem (interaction-environment))) 
			     body))
		  post)))
	     (define html
	       (wrap-element "<html>" "</html>"))
	     (define head
	       (wrap-element "<head>" "</head>"))
	     (define title
	       (wrap-element "<title>" "</title>"))
	     (define body
	       (wrap-element "<body>" "</body>"))
	     (define h1
	       (wrap-element "<h1>" "</h1>"))
	     (define table
	       (wrap-element "<table>" "</table>"))
	     (define td
	       (wrap-element "<td>" "</td>"))
	     (define tr
	       (wrap-element "<tr>" "</tr>"))
	     (define td
	       (wrap-element "<td>" "</td>")))

(define (print-html e)
  (print (eval e env)))

(define sample-html 
  '(html
    (head (title "Gauche Web"))
    (body (h1 "Gauche Web Page")
	  (table (tr (td "1") (td "lisp"))
		 (tr (td "2") (td "scheme"))))))

(print-html sample-html)

gosh> 
<html><head><title>Gauche Web</title></head><body><h1>Gauche Web Page</h1><table><tr><td>1</td><td>lisp</td></tr><tr><td>2</td><td>scheme</td></tr></table></body></html>
#t

なんかイヤだなあ。なんとかレキシカルを引っ張れないかな。SICP見たいな平等な実装ならenvを取り替えるだけだから造作も無いんだろうけども。。。もう少し勉強してみよう。

しかし件のページの次のページを見ると、一々面倒くさくやっていた自分が馬鹿みたいなのだ。
http://www.thinkit.co.jp/article/74/2/3.html

追記：
恥ずかしながら fold-rightがあることに気づいてなかったので修正。