はじめに

Unicode の全角・半角判定ルーチンで使用するため、EastAsianWidth.txt をパースして、全角文字の範囲を示すデータを作成します。
パーサーコンビネーターを使ってみたいので、正規表現は使用しません。

今回実装する内容

以下を実装していきます。

ファイルフォーマットを PEG で定義
定義した PEG をもとにパーサーを作成
作成したパーサで EastAsianWidth.txt をパース
パースした結果を加工してデータを作成

PEG 定義

EastAsianWidth.txt のフォーマットを PEG で表すと以下のようになります。

# [ファイル] は [行] の 0 回以上の繰り返しの後に [EOF]
FILE <- LINE* EOF

# [行] は [文字コードの範囲][セミコロン][文字種][パディング][コメント][改行] または [コメント][改行] または空行
LINE <- CODE_RANGE SEMI KIND PADDING COMMENT NL / COMMENT NL / NL

# [文字コードの範囲] は [文字コード][ドットドット][文字コード] または [文字コード]
CODE_RANGE <- CHAR_CODE DOTDOT CHAR_CODE / CHAR_CODE

# [文字コード] は [16 進数]
CHAR_CODE <- HEX

# [文字種] は "F", "W", "H", "Na", "A", "N" のいずれか
KIND <- "F" / "W" / "H" / "Na" / "A" / "N"

# [16 進数] は "0", "1", "2", "3" ... "F" の 1 回以上の繰り返し
HEX <- ( "0" / "1" / "2" / "3" / "4" / "5" / "6" / "7" / "8" / "9" /
         "A" / "B" / "C" / "D" / "E" / "F" )+

# [セミコロン] は ";"
SEMI <- ";"

# [パディング] は " " の 1 回以上の繰り返し
PADDING <- " "+

# [ドットドット] は ".."
DOTDOT <- ".."

# [改行] は 0x0A
NL <- 0x0A

# [コメント] は "#" の後に任意の文字の繰り返し
COMMENT <- "#" ANYCHAR

# ANYCHAR は省略

PEG 定義（簡略化版）

以下については前処理で実行することにして、先ほどの PEG を簡略化します。

行の切り出し
空行およびコメントだけの行の削除
パディングの削除
コメントの削除

以下が簡略化版の PEG です。

# [行] は [文字コードの範囲][セミコロン][文字種][行末]
LINE <- CODE_RANGE SEMI KIND END_OF_LINE

# [文字コードの範囲] は [文字コード][ドットドット][文字コード] または [文字コード]
CODE_RANGE <- CHAR_CODE DOTDOT CHAR_CODE / CHAR_CODE

# [文字コード] は [16 進数]
CHAR_CODE <- HEX

# [文字種] は "F", "W", "H", "Na", "A", "N" のいずれか
KIND <- "F" / "W" / "H" / "Na" / "A" / "N"

# [16 進数] は "0", "1", "2", "3" ... "F" の 1 回以上の繰り返し
HEX <- ( "0" / "1" / "2" / "3" / "4" / "5" / "6" / "7" / "8" / "9" /
         "A" / "B" / "C" / "D" / "E" / "F" )+

# [セミコロン] は ";"
SEMI <- ";"

# [ドットドット] は ".."
DOTDOT <- ".."

# [行末] は省略

この PEG 定義を使用してパーサーを作成します。

中間表現

パース結果として、ファイルの各行を以下の形式で出力します。

'([文字種] [文字コード 1] [文字コード 2])
;; ドットドットがない場合は [文字コード 1] と [文字コード 2] は同じ値

抽出

出力を受け取ったら、[文字種] が全角文字に相当するものだけを抜き出します。
今回抽出するのは、以下の F と W です。

F : Fullwidth
W : Wide
H : Halfwidth
Na : Narrow
A : Ambiguous
N : Neutral

結合

抽出したデータの各エントリーを確認し、次のエントリーと番号が繋がっているものは一つのエントリーにまとめます。

出力

最終的に以下の形式で出力します。

'(#x[文字コード] #x[文字コード])
'(#x[文字コード] #x[文字コード])
  ...
'(#x[文字コード] #x[文字コード])

文字コードのアルファベット部分は小文字にします。

パーサーの実装

今回のパースに固有ではない、汎用的に使用可能なパーサーと、今回のパース固有のパーサーの 2 種類を作成します。

汎用パーサーはライブラリにまとめておけば今後も再利用可能です。

汎用パーサー

作成するパーサーは以下の通りです。

string-parser : 文字列パーサー
eol-parser : 行末パーサー

作成するパーサーコンビネータは以下の通りです。

seq-parser : 順序パーサー
or-parser : 選択パーサー
rep1-parser : 1 回以上の繰り返しパーサー

ヘルパー関数として以下を作成します。

modify : パース結果を変形するために、変形用関数を適用する関数

専用パーサー

今回のパーシングに固有のパーサーとして、以下のパーサーを作成します。

dotdot-parser : ".." をパースするパーサー
semi-parser : ";" をパースするパーサー
hex-parser : 16 進数文字列をパースするパーサー
kind-parser : 文字種をパースするパーサー
char-code-parser : 文字コードをパースするパーサー
char-range-parser : 文字コードの範囲をパースするパーサー
line-parser : 行をパースするパーサー

パース結果を表すデータ

まず最初に、パーサーの返り値を作成するためのヘルパー関数を定義しておきます。

返り値の形式は、([パーシングが成功したか] [パースされた文字列] [パース済みの部分を取り除いた残りの文字列]) です。
パーシングが成功した場合は、リストの先頭が t になります。

;; make success result
(defun success (parsed rest)
  (list t parsed rest))

;; make failure result
(defun failure (rest)
  (list nil "" rest))

パース結果内のデータへのアクセス

パース結果のデータを処理するためのアクセッサを定義します。

success-p : パースが成功したかどうかを確認します
parsed : パースされた文字列を取得します
rest-string : パースされて残った文字列を取得します
concatenate-parsed : パース結果がネストした場合に、子のパース結果を連結してまとめます

;; check if succeeded
(defun success-p (parse-result)
  (nth 0 parse-result))

;; take parsed data
(defun parsed (parse-result)
  (nth 1 parse-result))

;; take remaining string for further parsing
(defun rest-string (parse-result)
  (nth 2 parse-result))

;; take a list of results and concatenate their parsed string
(defun concatenate-parsed (data)
  (apply #'concatenate 'string (mapcar #'parsed data)))

文字列パーサー

string-parser はパースする文字列を受け取り、その文字列をパースするパーサーを返します。
例えば、引き数に foo という文字列を受け取った場合は、foo をパースするパーサーを返します。

string-parser から返される関数は無名関数（クロージャ）です。
foo をパースするパーサー関数の場合は、引き数にパースする文字列を受け取り、その文字列が foo で開始されるかを確認します。

先ほど作成した success と failure でパース結果を返しています。

;; string-parser : string -> function
;; str : string -- パースする文字列
(defun string-parser (str)
  (let ((len (length str)))
    #'(lambda (data)
        (if (< (length data) len)
            (failure data)
            (let* ((substr (subseq data 0 len))
                   (match (string= str substr)))
              (if match
                  (success substr (subseq data len))
                  (failure str)))))))

行末パーサー

行末を判定するパーサーです。
パースする文字列のサイズが 0 だった場合に、行末であると判断します。

(defun eol-parser ()
  #'(lambda (data)
      (if (string= "" data)
          (success "" data)
          (failure data))))

順序パーサー

ここからはパーサーコンビネータの実装です。

seq-parser は複数のパーサーを受け取って、それを順番に実行するパーサーを返します。

foobarbaz という文字列があった場合に、foo パーサーと bar パーサーと baz パーサーを seq-parser に渡してあげると、パースが成功します。

%seq-parse というサブ関数を使用してパーサーの適用を実装しています。

(defun %seq-parse (acc str parsers)
  (if (not parsers)
      (success (reverse acc) str)
      (let* ((parser (car parsers))
             (result (funcall parser str)))
        (if (success-p result)
            (%seq-parse (cons result acc)
                        (rest-string result)
                        (cdr parsers))
            (failure nil)))))

(defun seq-parser (parsers)
  #'(lambda (data)
      (let ((result (%seq-parse nil data parsers)))
        (if (success-p result)
            result
            (failure data)))))

選択パーサー

or-parser は複数のパーサーを受け取って、そのいずれか一つがパースに成功するかどうかを確認するパーサーです。

受け取ったパーサーを一つずつ適用し、パースに成功するものがあれば成功を返します。

PEG の foo / bar / baz の記法に対応しています。

(defun %or-parse (str parsers)
  (if (not parsers)
      (failure nil)
      (let* ((parser (car parsers))
             (result (funcall parser str)))
        (if (success-p result)
            result
            (%or-parse str (cdr parsers))))))

(defun or-parser (parsers)
  #'(lambda (data)
      (let ((result (%or-parse data parsers)))
        (if (success-p result)
            result
            (failure data)))))

1 回以上の繰り返しパーサー

rep1-parser はパーサーを一つ受け取り、そのパーサーが 1 回以上連続で成功するかどうかを確認するパーサーです。

1 回もパースに成功しなかった場合は、失敗を返します。
1 回でもパースに成功した場合は、成功を返します。

PEG の foo+ に相当します。

(defun %rep1-parse (acc str parser)
  (labels ((result (acc str)
             (if acc
                 (success (reverse acc) str)
                 (failure str))))
    (if (= 0 (length str))
      (result acc str)
      (let* ((result (funcall parser str)))
        (if (success-p result)
            (%rep1-parse (cons result acc)
                         (rest-string result)
                         parser)
            (result acc str))))))

(defun rep1-parser (parser)
  #'(lambda (data)
      (%rep1-parse nil data parser)))

modify 関数

modify はパース結果を処理するための関数です。

引き数に一つのパーサーと、結果を加工するための関数を受け取り、パーサーを実行した結果に関数を適用します。
パース結果をもとに必要なデータを生成するために使用します。

(defun modify (parser fun)
  #'(lambda (data)
      (let ((result (funcall parser data)))
        (if (success-p result)
            (success (funcall fun result) (rest-string result))
            result))))

ドットドットパーサー

dotdot-parser は .. をパースするためだけのパーサーを返します。

パーサーが受け取った文字列が .. で始まっていた場合は成功となります。

(defun dotdot-parser ()
  #'(lambda (data)
      (if (> 2 (length data))
          (failure data)
          (let ((parser (string-parser "..")))
            (funcall parser data)))))

セミコロンパーサー

semi-parser は ; をパースするためだけのパーサーです。
string-parser を使用して作成します。

(defun semi-parser ()
  (string-parser ";"))

16 進数文字列パーサー

hex-parser は 16 進数文字列をパースするパーサーです。

サブ関数 %hex-parser で 16 進数文字列をパースしています。
string-parser で 16 進数に使用される文字をパースし、or-parser と rep1-parser を使用して、繰り返しを表現しています。

hex-modifier でパース結果を連結し、一つの 16 進数文字列を返しています。

(defun %hex-parser ()
  (rep1-parser
   (or-parser
    (list
     (string-parser "0")
     (string-parser "1")
     (string-parser "2")
     (string-parser "3")
     (string-parser "4")
     (string-parser "5")
     (string-parser "6")
     (string-parser "7")
     (string-parser "8")
     (string-parser "9")
     (string-parser "A")
     (string-parser "B")
     (string-parser "C")
     (string-parser "D")
     (string-parser "E")
     (string-parser "F")))))

(defun hex-modifier (data)
  (concatenate-parsed (parsed data)))

(defun hex-parser ()
  (modify (%hex-parser) #'hex-modifier))

文字種パーサー

kind-parser は文字種をパースするパーサーです。

Na が N より先に指定されているため、Na が N と判定されることはありません。

(defun kind-parser ()
  (or-parser
   (list
    (string-parser "F")
    (string-parser "W")
    (string-parser "H")
    (string-parser "Na")
    (string-parser "A")
    (string-parser "N"))))

文字コードパーサー

char-code-parser は文字コードをパースするパーサーを返します。
実装の実態は hex-parser です。

(defun char-code-parser ()
  (hex-parser))

文字コードの範囲パーサー

char-range-parser は文字コードの範囲をパースするパーサーを返します。

char-code-parser と dotdot-parser を組み合わせてパーサーを作成しています。

文字コードの範囲は、XXXX..YYYY の形式と、ZZZZ の形式の 2 種類があるので、両方の場合に対応する処理を実装しています。

char-range-modifier で文字コードの範囲のデータのみを抜き出し、16 進数文字列を数値に変換しています。

(defun single-char-code-modifier (data)
  (list data () data))

(defun %char-range-parser ()
  (or-parser
   (list
    (seq-parser
     (list
      (char-code-parser)
      (dotdot-parser)
      (char-code-parser)))
    (modify
     (char-code-parser)
     #'single-char-code-modifier))))

(defun char-range-modifier (data)
  (let ((p (parsed data)))
    (list
     (parse-integer (parsed (nth 0 p)) :radix 16)
     (parse-integer (parsed (nth 2 p)) :radix 16))))

(defun char-range-parser ()
  (modify (%char-range-parser) #'char-range-modifier))

行パーサー

line-parser は行をパースするパーサーを返します。

これまで作成してきたパーサーを組み合わせて、行のデータをパースしています。
返り値は ([文字種] [文字コード1] [文字コード2]) の形式に整形してあります。

(defun %line-parser ()
  (seq-parser
   (list
    (char-range-parser)
    (semi-parser)
    (kind-parser)
    (eol-parser))))

(defun line-modifier (data)
  (let ((p (parsed data)))
    (cons
     (parsed (nth 2 p))
     (parsed (nth 0 p)))))

(defun line-parser ()
  (modify (%line-parser) #'line-modifier))

パーサーの実装は以上で終了です。

パーサーの実行

ここからはプログラムの駆動部分を実装します。
具体的には以下の処理を実装します。

ファイルからデータを読み取る
前処理を施す
パーサーを実行する
出力を加工する
ファイルに書き出す

コメント行の確認

空行もしくは # で始まっている行かどうかを判定します。

(defun check-comment-line (line)
  (or (string= "" line)
      (string= "#" (subseq line 0 1))))

コメントの除去

前処理の一環として、行データからコメントを削除します。

(defun remove-comment (line)
  (let ((position (position #\# line :test 'equal)))
    (subseq line 0 position)))

パディングの除去

前処理の一環として、行データからパディングを削除します。

(defun remove-padding (line)
  (string-right-trim " " line))

行のパース

行データにパーサーを適用します。

基本的にはパースは失敗しない前提です。
もしパースが失敗した場合は、エラーを発生させ、デバッガが起動します。

(defun parse-line (line)
  (let* ((parser (line-parser))
         (result (funcall parser line)))
    (if (success-p result)
        result
        (error "[parse error] ~S" line))))

全角文字列データの抜き出し

文字種が全角のものだけを抽出します。

(defun select-wide (data)
  (let* ((p (parsed data))
         (kind (nth 0 p)))
    (if (or (string= "F" kind)
            (string= "W" kind))
        (cdr p)
        nil)))

行データに対する処理のまとめ

ここまでの処理を process-line 関数にまとめます。

(defun process-line (line)
  (if (check-comment-line line)
      nil
      (select-wide
       (parse-line
        (remove-padding
         (remove-comment line))))))

ファイルのオープンとファイルに対する処理

ローカルに配置した EastAsianWidth.txt を開き、行単位で読み込んで、先ほどの process-line 関数を適用します。

(defun process-file ()
  (with-open-file (file
                   (make-pathname :name "EastAsianWidth.txt"))
    (labels ((process-lines (acc)
               (let ((line (read-line file nil)))
                 (if (not line)
                     (reverse acc)
                     (let ((result (process-line line)))
                       (if (not result)
                           (process-lines acc)
                           (process-lines (cons result acc))))))))
      (process-lines nil))))

連続する文字コードの連結

文字コードの範囲が連続している場合は、前後を連結します。

(defun %merge-ranges (acc data)
  (if (> 2 (length data))
      (reverse (append data acc))
      (let ((fst (nth 0 data))
            (snd (nth 1 data))
            (remains (nthcdr 2 data)))
        (if (= (1+ (nth 1 fst))
               (nth 0 snd))
            (%merge-ranges acc
                           (cons (list (nth 0 fst) (nth 1 snd))
                                 remains))
            (%merge-ranges (cons fst acc)
                           (rest data))))))

(defun merge-ranges (data)
  (%merge-ranges nil data))

16 進数文字列への変換

数値データを 16 進数文字列データに変換します。

(defun %hexadecimalize (acc data)
  (let ((convert (lambda (num)
                   (string-downcase
                    (concatenate 'string
                                 "#x"
                                 (write-to-string num :base 16))))))
    (if (not data)
        (reverse acc)
        (let ((pivot (first data)))
          (%hexadecimalize
           (cons (list (funcall convert (nth 0 pivot))
                       (funcall convert (nth 1 pivot)))
                 acc)
           (rest data))))))

(defun hexadecimalize (data)
  (%hexadecimalize nil data))

出力したい文字列への変換

16 進数文字列を括弧でくくり、最終的な出力形式に加工します。

(defun %list-to-string (list)
  (concatenate 'string
               "'("
               (nth 0 list)
               " "
               (nth 1 list)
               ")"))


(defun make-output-string ()
  (let ((data (hexadecimalize (merge-ranges (process-file))))
        (width 4))
    (labels ((list-to-string (acc newline data)
               (if (not data)
                   acc
                   (let ((pivot (first data))
                         (nl (= 0 (mod newline width))))
                     (list-to-string
                      (concatenate 'string
                                   acc
                                   (%list-to-string pivot)
                                   (if nl
                                       (string #\newline)
                                       " "))
                      (1+ newline)
                      (rest data))))))
      (list-to-string "" 1 data))))

結果の出力

ここまでの処理の結果をファイルに出力します。

(defun output-to-file ()
  (with-open-file (file
                   (make-pathname :name "output.txt")
                   :direction :io
                   :if-exists :supersede)
    (princ (make-output-string)
           file)))

プログラムの実行

output-to-file 関数を実行すると、カレントディレクトリの output.txt ファイルに処理結果が格納されます。

(output-to-file)

出力の正しさの検証

Vim の実装と比較して、同一のデータであることを確認しました。

終わりに

このプログラムの用途

最近使い始めたソフトウェアが対応している Unicode のバージョンが 7.0 でした。
一方、Unicode の現時点での最新バージョンは 11.0 です。

Unicode 7.0 で困ることは、絵文字の全角判定です。
絵文字を全角とすることは Unicode 9.0 で推奨となったようです。
そのため、Unicode 9.0 より前のバージョンに対応している実装では、絵文字が半角文字とみなされてしまうことがあります。

これを避けるため、最新の Unicode バージョンに対応する必要がありました。

実装してみて

パーサーコンビネータは簡単に作成できて楽しい！

おしまい