JSON Parser with Monadic Parser Combinators

PLT Scheme には既に JSON のパーサーが2つあるんですが:
http://www.lshift.net/blog/2005/08/22/json-for-mzscheme-and-a-portable-packrat-parsing-combinator-library
http://planet.plt-scheme.org/display.ss?package=json.plt&owner=dherman
気にせず作ってみました。

JSON 自体は文法が簡単なので短時間で作れたんですが、その過程でライブラリの重大な欠点も見つかりました。Scheme の #f の値をパース失敗と見なす方式だったために、JavaScript の "false" の値を #f に変換できない、という問題が判明したんです。

そのような問題修正やブラッシュアップを施したコードはこちらです (まだパース失敗のレポートなどの機能はありません):
Sources:
parser.ss
json.ss

以下、コードです:

;;; 2.4 Numbers

(define minus (char #\-))
(define plus (char #\+))

(define int
  (fmap list->string (many1 digit)))

(define fraction
  (doP (char #\.)
       (n <- int)
       (return (string-append "." n))))

(define exponent
  (doP (one-of '(#\e #\E))
       (s <- (|| minus plus))
       (n <- int)
       (return
        (string-append "e" (string s) n))))

(define j:number
  (doP (s <- (option "" minus))
       (i <- int)
       (f <- (option "" fraction))
       (e <- (option "" exponent))
       (return
        (string->number
         (format "~a~a~a~a" s i f e)))))

Scheme のプリミティブや他のパーサー等との衝突を防ぐため、一部の名前に j: という接頭辞を付けてあります。

最初に数値リテラルの文法を定義しました (j:number)。整数のほかに小数と指数部分があり、10進表記のみ許可されています。string->number で最終的に Scheme の数値に変換していますが、Scheme は数値リテラルで複素数をも表す関係上、若干文法が異なるので注意が必要です。

;;; 2.5 Strings

(define quote-mark (char #\"))

(define unescaped
  ;; unescaped = %x20-21 / %x23-5B / %x5D-10FFFF
  (let ((char-range
         (lambda (i)
           (or (<= #x20 i #x21)
               (<= #x23 i #x5B)
               (<= #x5D i #x10FFFF)))))
    (satisfy
     (compose char-range char->integer))))

(define char-parsers
  `((#\" . ,(return #\"))
    (#\\ . ,(return #\\))
    (#\/ . ,(return #\/))
    (#\b . ,(return #\backspace))
    (#\f . ,(return #\page))
    (#\n . ,(return #\newline))
    (#\r . ,(return #\return))
    (#\t . ,(return #\tab))
    (#\u . ,(doP (hd <- (count 4 hex-digit))
                 (return
                  (integer->char
                   (string->number (list->string hd) 16)))))))

(define j:char
  (|| unescaped
      (doP (char #\\)
           (c <- (one-of (map car char-parsers)))
           (cdr (assq c char-parsers)))))

(define j:string
  (doP quote-mark
       (cs <- (many j:char))
       quote-mark
       (return (list->string cs))))

char-parsers として文字とパーサーの対応表を作っているところに Lisp らしさが出ていると思います。j:char の定義の最後の行は我ながらかっこいいです。

;;; 2.2 Objects

(define j:member
  (let ((bare-string
         (doP (c <- letter)
              (cs <- (many alphanum))
              (return
               (list->string (cons c cs))))))
    (doP (k <- (lexeme (|| j:string bare-string)))
         (lexeme (char #\:))
         (v <- j:value)
         (return (cons (string->symbol k) v)))))

(define j:object
  (braces
   (doP (o <- (comma-sep (lexeme j:member)))
        (return (make-immutable-hasheq o)))))

JSON のオブジェクトはブレースで囲まれた、キーと値のペアの連続です。キーとして、文法上は2重引用符で囲まれた文字列のみが有効とされているんですが (これについてはずっと前に id:brazil さんに教えていただいた記憶があります。あの頃は大の Lisp ぎらいでした…)、一応甘めに裸の文字列でも可としてみました。

なお、(lexeme p) はパーサー p を実行した後に空白を読み飛ばす、というパーサーです。

;;; 2.3 Arrays

(define j:array
  ;; KLUGE: delaying evaluation of j:value
  (doP white-space
       (squares (comma-sep (lexeme j:value)))))

配列はオブジェクトよりずっと単純な定義なんですが、Haskell と違って評価順序を気にしなければいけないという残念さがあります。

(squares (comma-sep (lexeme j:value)))

「角括弧で囲まれた、コンマで区切られた j:value の並び」、という定義だけでは 「j:value が未定義」というエラーになってしまうんです。j:value の方も j:array の定義を必要とするので j:value を先に定義するわけにもいかないんですね。

ということで、ここでは j:value への参照を関数のスコープの中に閉じ込める方法を採りました。(doP はマクロ展開されると第2式以降を lambda の中に閉じ込めます)

;;; 2. JSON Grammer

(define json-text
  (|| j:object j:array))

これが正式な JSON テキストの文法です。つまり、トップレベルには文字列や数値リテラルなどは置けないわけですね。

また、はてブの JSON データのように (例: http://b.hatena.ne.jp/entry/json/http://www.plt-scheme.org/) テキスト全体を "(" ")" で囲った形式は文法では定義されていないことになります。したがって、JSON 文法を忠実に実装しているライブラリはこの形式のデータをパースできません。(ただし、JavaScript の eval でエラーが出ないように、という現実的な配慮があってのことで、悪いことではありません)

;;; 2.1 Values

(define j:false
  (>> (chars "false") (return #f)))

(define j:null
  (>> (chars "null") (return (void))))

(define j:true
  (>> (chars "true") (return #t)))

(define j:value
  (|| json-text j:string j:false j:true j:number j:null))

3つの特殊リテラルと、JSON の値の集合の定義です。

;;; JSON Parser

(define json
  (>> white-space (|| json-text (parens json-text))))

(define (read-json in)
  (parse json in))

以上、非常にシンプルに、かつ文法に忠実なスタイルでパーサーを定義することができたと思います。Packrat ベースのものと比較すると3割かそれ以上遅いようなんですが、最適化は今後の課題です。

動作例として、Google 検索の JSON API を利用してみました:

(call/input-url
    (string->url
     "http://www.searchmash.com/results/combinatory+logic?n=1")
  get-pure-port read-json)

#hasheq((query . #hasheq((prefix . "") (terms . "combinatory logic")))
        (estimatedCount . "67,200")
        (moreResults . #t)
        (event . "CNjExpPnsJUCFQ2FagodvGgOBA")
        (chat . "")
        (spelling
         .
         #hasheq((query . "combinatorial logic")
                 (html . "<b><i>combinatorial</i></b> logic")))
        (results
         #hasheq((url . "http://en.wikipedia.org/wiki/Combinatory_logic")
                 (title
                  .
                  "<b>Combinatory logic</b> - Wikipedia, the free encyclopedia")
                 (snippet
                  .
                  "<b>Combinatory logic</b> is a notation introduced by Moses Sch‡nfinkel and Haskell Curry <br>  to eliminate the need for variables in mathematical <b>logic</b>. <b>...</b>")
                 (site . "en.wikipedia.org")
                 (rawUrl . "http://en.wikipedia.org/wiki/Combinatory_logic")
                 (cacheUrl
                  .
                  "http://www.google.com/search?q=cache:c1ZR-mNe8moJ:en.wikipedia.org/wiki/Combinatory_logic+combinatory+logic&hl=en&gl=us&ct=clnk&cd=1")
                 (displayUrl . "en.wikipedia.org"))))

[追記]

上記 Packrat ベースの JSON パーサーのソースを見ていて気づいたんですが、エスケープされたユニコード文字列の変換処理をしていませんでした。はてブの日本語を含む JSON データで速度比較をしていたのでフェアじゃなかったですね。出力に void を掛けて見えなくしていたので気づきませんでした…

[追記]
Packrat パーサーに関する論文 (http://pdos.csail.mit.edu/~baford/packrat/thesis/) を読んでいて分かったんですが、Packrat は線形時間のアルゴリズムなので、指数関数時間の Parsec ライクなパーサーとは比較しても意味無かったみたいです。 (Parsec が指数関数時間というのはちょっと事実誤認があったようです)

あと修正なんですが、数値のパーサーの定義がおかしかったようで、指数がちゃんと変換できてませんでした。