packratの機能追加

SagittariusにはChicken由来のpackratライブラリがあるのだが、このライブラリ数量指定子が使えなくて非常に使い出が悪い。例えば、0個以上の何かを取るというのを書くのに以下のようにする必要がある。

(import (rnrs) (packrat))

(define (generator tokens)
  (let ((stream tokens))
    (lambda ()
      (if (null? stream)
          (values #f #f)
          (let ((base-token (car stream)))
            (set! stream (cdr stream))
            (values #f base-token))))))

(define quantifier (packrat-parser
                    top
                    (top ((vs <- item*) vs))
                    (item* ((i <- item i* <- item*) (cons i i*))
                           (() '()))
                    (item (('+) '+))))


(let* ((q (generator '((+) (+) (+))))
       (r (quantifier (base-generator->results q))))
  (parse-result-semantic-value r))
;; -> (+ + +)

BNFで書かれた定義を持ってくる際に数量指定子がないというのは非常に面倒で、パーサを書くのを何度も何度も億劫にしてくれた。quantifierの定義はこう書けた方が直感的である。

(define quantifier (packrat-parser
                    top
                    (top ((vs <- (* item)) vs))
                    (item (('+) '+))))

ずっとほしいと思っていたのだが、そろそろあった方がいいなぁという気運が高まってきたので、えいや！っと中身を読むことにした。

中身を読んで分かったのは、複数回マッチするというのを何とかするAPIが足りていないのが原因ぽかったので、こんなのを追加してマクロ側にも手を入れてみた。

(define (packrat-many parser n m k)
  (lambda (results)
    (define (>=? many max) (and max (>= many max)))
    (define (return-results vs result)
      ;; if we inline map then for some reason step on a bug...
      (let ((vals (map parse-result-semantic-value vs)))
        (merge-result-errors ((k vals)
                              (parse-result-next result))
                             (parse-result-error result))))
    (when (and (zero? n) (eqv? n m))
      (error 'packrat-many "both min and max are zero" n m))
    (let loop ((i 0) (vs '()) (s #f) (results results))
      (if (>=? i m)
          (return-results (reverse! vs) s)
          (let ((result (parser results)))
            (cond ((parse-result-successful? result)
                   (loop (+ i 1) (cons result vs) result
                         (parse-result-next result)))
                  ((<= n i)
                   (return-results (reverse! vs) result))
                  (else result)))))))

なぜか、インライナーのバグを踏んだのはまぁご愛嬌ということで・・・
マクロの方は+、*、?に加えてマッチ回数を指定できる=も入っている。長いのでここには載せない。これで多少便利になる気がする。