Form Letters

Form Letters | Programming Praxisを解いてみました。
あるテキスト中に埋め込まれた $n を単語列中のn番目の要素で置き換えるという、簡単なテンプレートエンジンを作る問題です。
テンプレートとなるテキストを受け取って、単語リストを与えられたら文章を生成する関数を返す、高階関数を作りました。たとえば、"test $1 test $0"というテキストを処理したい場合、

((lambda () "test") ) (lambda () (ref wordlist 0)) (lambda () "test")  (lambda () (ref wordlist 1))

というリストを生成し、リストの各要素を評価した上で連結する関数が返ります。
この関数に単語リストを渡すと結果のテキストが得られます。

gosh> (define schema (parse-schema "test $1 test $0"))
schema
gosh> (schema '("!" "!!"))
"test !! test !"

という具合。On Lispに載っていた表現としての関数、というのをやってみたかったんですが、実際のところどこまで効率的になっているのかわからないです。
単語リストが足りない場合はエラーで終了します。エラーをキャッチして空白にでも置き換えてもいいんですが、エラー出る方が良いかなあという気もするのでそのままにしておきます。

(define (number-char? chr)
  (and (char<=? #\0 chr) (char<=? chr #\9)))

(define (parse-chars charlist result preg midproc endproc)
  (call/cc
   (lambda (break)
     (let loop ((charlist charlist) (buffer ()) (result result))
       (cond [(null? charlist) (endproc buffer result)]
	     [(preg (car charlist))
	      (loop (cdr charlist) () (midproc break charlist buffer result))]
	     [else (loop (cdr charlist) (cons (car charlist) buffer) result)])))))
   
(define (parse-wordlist str splitter)
  (define (add2wordlist buffer wordlist)
    (if (null? buffer) wordlist (cons (list->string (reverse buffer)) wordlist)))
  (parse-chars (string->list str) ()
	       (cut char=? <> splitter)
	       (lambda (break charlist buffer result) (add2wordlist buffer result))
	       (lambda (buffer result) (reverse (add2wordlist buffer result)))))

(define (parse-schema str)
  (let ((wordlist ()))
    (define (sepalator? char) (char=? #\$ char))
    (define (addwords buffer schema)
      (if (null? buffer) schema (let ((words (list->string (reverse buffer))))
				    (cons (lambda () words) schema))))
    (define (addtmplt buffer schema)
      (if (null? buffer) schema
	(let ((idx (x->integer (list->string (reverse buffer)))))
	  (cons (lambda () (ref wordlist idx)) schema))))
    (define (main-loop charlist schema)
      (parse-chars charlist schema sepalator?
		   (lambda (break chlst buffer schema)
		     (break (subst-loop (cdr chlst) (addwords buffer schema))))
		   (lambda (buffer schema) (reverse (addwords buffer schema)))))
    (define (subst-loop charlist schema)
      (if (sepalator? (car charlist))
	  (main-loop (cdr charlist) (addwords '(#\$) schema))
	  (parse-chars charlist schema (compose not number-char?)
		       (lambda (break chlst buffer schema)
			 (break (main-loop chlst (addtmplt buffer schema))))
		       (lambda (buffer schema) (reverse (addtmplt buffer schema))))))
    (let ((schema (main-loop (string->list str) ())))
      (lambda (wrdlst)
	(set! wordlist wrdlst)
	(string-join (map (lambda (proc) (proc)) schema) "")))))

(define (main args)
  (if (null? (cddr args)) (begin (print "input file name") (exit)))
  (let* ((template (call-with-input-file (ref args 1) (lambda (in) (port->string in))))
	 (schema (parse-schema template)))
    (call-with-input-file (ref args 2)
      (lambda (in)
	(port-for-each (lambda (line) (print "") (display (schema (parse-wordlist line #\,))))
		       (lambda () (read-line in) ))))))

parse-wordlistは単なるstring-splitの劣化版です。parse-charsは文字を一文字ずつバッファに読み込んでいって、特定の文字が来たらアクションを起こすという部分を切り出してます。