正規表現とPrologとCommon Lisp

磯野ォ～、非決定性やろうぜ～！みたいなノリで、NFAを扱えないか考えていました。
PrologでNFAを扱うのはそんなに珍しい事じゃないと思いますので、 やっている人は沢山いると思います。
同じようにCommon LispでNFAを扱う人も普通にいます。
過去に自分もNFA経由でDFAを作ったりしたことがあります。
でもPrologとCommon Lispを合わせて扱った人はあまりいないのでは？
ということでやってみます。

申し遅れましたが、前回の続きです。

• Prologのようなものを作る - nptclのブログ
• 麻雀とPrologとCommon Lisp - nptclのブログ

1. 正規表現を表す

今回作成したmatchは、Common LispからPrologを使えるというものです。
Prologの操作は実行だけではなく、ルールの定義もCommon Lispからできます。
つまり、正規表現のためのルールをCommon Lispで自由に定義できるということです。

今回はNFAの実行に焦点を当てますので、正規表現の字面の分析は飛ばします。
ぜんぶ、Listで表されていることにします。

どういうことかというと、

Helloは、(and #\H #\e #\l #\l #\o)
[abc]は、(or #\a #\b #\c)
a*は、(* #\a)
a+は、(+ #\a)
a?は、(? #\a)
.は、_

のようになります。
当たり前ですが、(and #\1 (+ (or #\2 #\3)) #\4)みたいな複合も可能です。

簡単のためにnotである[^a]や範囲指定[A-Z]はやめます。
やってもいいんですけど、多少面倒になるので今回はパス。

2. Common Lispの準備

matchを読み込んでください。

NFAというのは、非決定性有限オートマトンだそうです。
何が何やらですが、オートマトンにはまず「状態」があって、条件によって他の状態へ「遷移」します。
Prologでは、ルールを状態、実行を遷移に対応させます。

状態は、例えば次のように作成します。

(defrule (#:g123 ?v)
  ...)

見てわかるように、名前はgensymにしました。
引数?vは入力の文字列です。
この文字列が、正規表現に一致しているかどうかを調べるわけです。
Prologの都合上、入力はリストに直してください。
入力文字列が"ABC"なら、(#\A #\B #\C)になります。

状態g1から状態g2へ、無条件に遷移することを考えてみます。
遷移は実行によってあらわされますので、次のようになります。

(defrule (#:g1 ?v)
  (#:g2 ?v))

これをCommon Lispの関数nfa-epsilonで表してみます。

(defun nfa-epsilon (s z)
  (define-rule `(,s ?v) `(,z ?v)))

例で示したように状態g1から状態g2への遷移は次の通りです。

(nfa-epsilon '#:g1 '#:g2)

それでは、初期状態と最終状態を作りましょう。
初期状態がstartで、最終状態が#:finalという名前にします。

最終状態は簡単です。
ただ終了させるだけです。

(defrule (#:final _))

初期状態を作成する前に、正規表現を扱う関数を紹介します。
次のような関数を用意します。

(defun parse-nfa (reg s)
   ...
   z)

この関数は、正規表現regと状態sを受け取り、新たな状態zを返却します。
これらを全て組み合わせると、次のような処理が出来上がります。

(defun start-nfa (start reg)
  (let ((z (parse-nfa reg start))
        (final (gensym)))
    (nfa-epsilon z final)
    (define-rule `(,final _))))

呼び出しは、例えば次のようになります。

(defun match-regex (regex input)
  (with-match
    (start-nfa 'start regex)
    (nth-value 1 (match-true `(start ,input)))))

(match-regex
  '(and #\H _ _ _ _ #\!)
  '(#\H #\e #\l #\l #\o #\!))

parse-nfa関数は次のようになります。

(defun parse-list (reg s)
  (destructuring-bind (car . cdr) reg
    (ecase car
      (and (nfa-and cdr s))
      (or (nfa-or cdr s))
      (* (nfa-kleene cdr s))
      (+ (nfa-plus cdr s))
      (? (nfa-once cdr s)))))

(defun parse-nfa (reg s)
  (cond ((consp reg) (parse-list reg s))
        ((eq reg '_) (nfa-any s))
        (t (nfa-value reg s))))

この関数は、種類に対応する別の関数を呼び出しているだけです。
それでは一つずつ作成してみましょう。

3. NFAの構築

まずは文字を扱うnfa-valueから行きましょう。
例えば、文字#\cがマッチしたかどうかは、次のようなルールになります。

(defrule (#:s (#\c . ?v))
  (#:z ?v))

つまりはこんな感じ

;;  --> s --> c --> z -->
(defun nfa-value (c s)
  (let ((z (gensym)))
    (define-rule `(,s (,c . ?v)) `(,z ?v))
    z))

どんどん行きましょう。
次は任意の一文字_です。
文字の場合と同じで、cが_になっただけです。

;;  --> s --> any --> z -->
(defun nfa-any (s)
  (nfa-value '_ s))

ここまでできれば、一応は動作確認ができるのでやってみましょう。

(match-regex #\a '(#\a))
-> T

(match-regex #\a '(#\z))
-> NIL

(match-regex '_ '(#\z))
-> T

うまく動作しています。

次はandとor。

;;  --> s --> reg1 --> reg2 --> reg3 --> z -->
(defun nfa-and (cdr s)
  (let ((z (gensym)))
    (dolist (reg cdr)
      (setq s (parse-nfa reg s)))
    (nfa-epsilon s z)
    z))

;;  --> s --> reg1 --> |
;;      | --> reg2 --> |
;;      | --> reg3 --> z-->
(defun nfa-or (cdr s)
  (let ((z (gensym)))
    (dolist (reg cdr)
      (let ((x (parse-nfa reg s)))
        (nfa-epsilon x z)))
    z))

andは、各要素を直列に繋いでいます。
orは、各要素を並列に繋いでいます。

テストしてみましょう。

(match-regex
  '(and #\H _ _ _ _ #\!)
  '(#\H #\e #\l #\l #\o #\!))
-> T

(match-regex
  '(and (or #\a #\A) (or #\b #\B) #\c)
  '(#\A #\b #\c))
-> T

(match-regex
  '(and (or #\a #\A) (or #\b #\B) #\c)
  '(#\A #\B #\C))
-> NIL

続いて、a*。

;;      --------->------->---------
;;      |                         |
;;  --> s --> a --> reg --> b --> z -->
;;            |             |
;;            -------<-------
(defun nfa-kleene (cdr s)
  (destructuring-bind (reg) cdr
    (let* ((z (gensym))
           (a (gensym))
           (b (parse-nfa reg a)))
      (nfa-epsilon s z)
      (nfa-epsilon s a)
      (nfa-epsilon b a)
      (nfa-epsilon b z)
      z)))

これは、クリーネ閉包と呼ばれるものです。
0回以上の繰り返しを意味します。

(match-regex
  '(and #\A (* (or #\B #\C)) #\D)
  '(#\A #\B #\B #\C #\B #\D))
-> T

(match-regex
  '(and #\A (* (or #\B #\C)) #\D)
  '(#\A #\D))
-> T

次は、a+とa?。

;;  --> s --> reg --> z -->
;;      |             |
;;      -------<-------
(defun nfa-plus (cdr s)
  (destructuring-bind (reg) cdr
    (let ((z (parse-nfa reg s)))
      (nfa-epsilon z s)
      z)))

;;  --> s --> reg --> z -->
;;      |             |
;;      ------->-------
(defun nfa-once (cdr s)
  (destructuring-bind (reg) cdr
    (let ((z (parse-nfa reg s)))
      (nfa-epsilon s z)
      z)))

a+は、一回以上の繰り返し。
a?は、0回か1回の出現。
両者はnfa-epsilonの向きが反対なだけですが、意味は結構違っています。

(match-regex
  '(and (? #\1) (+ (or #\7 #\8)))
  '(#\1 #\7 #\7 #\8 #\8))
-> T

(match-regex
  '(and (? #\1) (+ (or #\7 #\8)))
  '(#\7 #\7 #\7 #\8 #\8))
-> T

(match-regex
  '(and (? #\1) (+ (or #\7 #\8)))
  '(#\1))
-> NIL

4. 完成

これで終わりです。
個人的な感想としては、なんでうまく動いてるんだ？
ただNFAを作っただけで何もしてないんですが。
Prologってこういうものなのか。

正規表現のコードは何度か作る機会がありまして、 そのたびに結構苦労してたのですけど、 こんなに簡単に実装できたのは今回が初めてです。
でも万能ってわけではないと思います。
例えば、ab(c*)deみたいにカッコで囲んだ場合は、 そこだけ後で\1で参照できるすごいモジュールがあったりしますが、 それをこれで実現するには結構大変なのでは？
NFAはDFAと違い、いろんな事ができるのが売りだと思います。
だからこの辺の事情は無視できないのではないでしょうか。

一応、ソースを載せます。

(load #p"match.lisp")
(defpackage work (:use cl match))
(in-package work)

;;
;;  parse-nfa
;;
(declaim (ftype function parse-nfa))

;;  --> s --> z -->
(defun nfa-epsilon (s z)
  (define-rule `(,s ?v) `(,z ?v)))

;;  --> s --> c --> z -->
(defun nfa-value (c s)
  (let ((z (gensym)))
    (define-rule `(,s (,c . ?v)) `(,z ?v))
    z))

;;  --> s --> any --> z -->
(defun nfa-any (s)
  (nfa-value '_ s))

;;  --> s --> reg1 --> reg2 --> reg3 --> z -->
(defun nfa-and (cdr s)
  (let ((z (gensym)))
    (dolist (reg cdr)
      (setq s (parse-nfa reg s)))
    (nfa-epsilon s z)
    z))

;;  --> s --> reg1 --> |
;;      | --> reg2 --> |
;;      | --> reg3 --> z-->
(defun nfa-or (cdr s)
  (let ((z (gensym)))
    (dolist (reg cdr)
      (let ((x (parse-nfa reg s)))
        (nfa-epsilon x z)))
    z))

;;      --------->------->---------
;;      |                         |
;;  --> s --> a --> reg --> b --> z -->
;;            |             |
;;            -------<-------
(defun nfa-kleene (cdr s)
  (destructuring-bind (reg) cdr
    (let* ((z (gensym))
           (a (gensym))
           (b (parse-nfa reg a)))
      (nfa-epsilon s z)
      (nfa-epsilon s a)
      (nfa-epsilon b a)
      (nfa-epsilon b z)
      z)))

;;  --> s --> reg --> z -->
;;      |             |
;;      -------<-------
(defun nfa-plus (cdr s)
  (destructuring-bind (reg) cdr
    (let ((z (parse-nfa reg s)))
      (nfa-epsilon z s)
      z)))

;;  --> s --> reg --> z -->
;;      |             |
;;      ------->-------
(defun nfa-once (cdr s)
  (destructuring-bind (reg) cdr
    (let ((z (parse-nfa reg s)))
      (nfa-epsilon s z)
      z)))


;;
;;  main
;;
(defun parse-list (reg s)
  (destructuring-bind (car . cdr) reg
    (ecase car
      (and (nfa-and cdr s))
      (or (nfa-or cdr s))
      (* (nfa-kleene cdr s))
      (+ (nfa-plus cdr s))
      (? (nfa-once cdr s)))))

(defun parse-nfa (reg s)
  (cond ((consp reg) (parse-list reg s))
        ((eq reg '_) (nfa-any s))
        (t (nfa-value reg s))))

;;  start --> z --> final
(defun start-nfa (start reg)
  (let ((z (parse-nfa reg start))
        (final (gensym)))
    (nfa-epsilon z final)
    (define-rule `(,final _))))

(defun match-regex (regex input)
  (with-match
    (start-nfa 'start regex)
    (nth-value 1 (match-true `(start ,input)))))

(format t "~S~%"
        (match-regex
          '(and #\H _ _ _ _ #\!)
          '(#\H #\e #\l #\l #\o #\!)))