[Perl] 以正規表示式所定義的文法規則來做編譯器

作者：gugod 發佈於：2022/07/20 ，更新於：2022/07/21 #perl #regex

在前文〈[Perl] 以正規表示式來定義文法規則〉文中所定義的 $JSON_GRAMMAR 是一個能完整地比對 JSON 文件的正規表示式，並且在其中透過了類似 BNF 的語法，以 perl 正規表示式引擎本身的處理能力來完整地是做出了一個遞迴下降解析器。

但這個解析器只能做到一件事：去辨別一個字串是否看起來像是一份 JSON 文件，畢竟它就是個正規表示式。也就是說，雖然在其中定義出了各式各樣的 token 型別，但其實它的輸出只能是個布林值。如果能讓它輸出類似語法樹的資料結構，或是輸出帶有夠多輔助註解的 token 列表，都會好用得多。

無奈，這兩件事都不是立刻就能做到的。甚至要直接將 $JSON_GRAMMAR 拿來重複利用，都不太容易。

以下是我找出的一種方式：可配合 (?{ ... }) 這種能內嵌程式碼的特殊語法，讓每一個 token 比對成功之後，就執行 emit() 函式。並且在 emit() 函式裡面記錄下各個 token 出現的位置。比對完畢之後，再整理一下，做成 token 列表。

爲了解析方便，$JSON_GRAMMAR 的語法規則本身也被大幅修改。大致上分成 token 與 rule 兩類。帶有 (?{ emit(...) }) 的就是 token，沒帶的就是 rule。目的是在取得所有 token 依照次序引出來後，能得到原本的 JSON 文件。

use v5.36;
use JSON        qw(encode_json);
use File::Slurp qw(read_file);
use Digest::SHA1 qw(sha1_base64 sha1_hex);

my $JSON_GRAMMAR = qr{
    (?(DEFINE)
        (?<JSON>
            (?&element))

        (?<object>
            ((?&objectBeginDelimiter) ((?&ws) | (?&members)) (?&objectEndDelimiter)))

        (?<array>
            ((?&arrayBeginDelimiter) ((?&ws) | (?&elements)) (?&arrayEndDelimiter)))

        (?<elements>
            ( (?&element) (?&arrayElementDelimiter) (?&elements) | (?&element) ))

        (?<members>
            ( (?&member) (?&objectMemberDelimiter) (?&members) | (?&member) ))

        (?<element>
            ( (?&ws) (?&value) (?&ws) ))

        (?<member>
            ( (?&ws) (?&string) (?&ws) (?&objectMemberKVDelimiter) (?&element) ))

        (?<value>
            ( (?&object) | (?&array) | (?&string) | (?&number) | (?&valueTrue) | (?&valueFalse) | (?&valueNull) ))

        (?<valueTrue> ( true )
            (?{ emit("valueTrue", $^N, pos())}))

        (?<valueFalse> ( false )
            (?{ emit("valueFalse", $^N, pos())}))

        (?<valueNull> ( null )
            (?{ emit("valueNull", $^N, pos())}))

        (?<objectBeginDelimiter> ( { )
            (?{ emit("objectBeginDelimiter", $^N, pos())}))

        (?<objectEndDelimiter> ( } )
            (?{ emit("objectEndDelimiter", $^N, pos())}))

        (?<objectMemberDelimiter> ( , )
            (?{ emit("objectMemberDelimiter", $^N, pos())}))

        (?<objectMemberKVDelimiter> ( : )
            (?{ emit("objectMemberKVDelimiter", $^N, pos())}))

        (?<objectMemberDelimiter> ( , )
            (?{ emit("arrayElementDelimiter", $^N, pos())}))

        (?<arrayBeginDelimiter> ( \[ )
            (?{ emit("arrayBeginDelimiter", $^N, pos())}))

        (?<arrayEndDelimiter> ( \] )
            (?{ emit("arrayEndDelimiter", $^N, pos())}))

        (?<arrayElementDelimiter> ( , )
            (?{ emit("arrayElementDelimiter", $^N, pos())}))

        (?<number>
            ( (?&integer) (?&fraction) (?&exponent) )
            (?{ emit("number", $^N, pos())}))

        (?<integer>
            ( (?&onenine) (?&digits) | (?&digit) | - (?&onenine) (?&digits) | - (?&digit) ))

        (?<digits>
            ( (?&digit)+ ))

        (?<fraction>
            ( | \. (?&digits) ))

        (?<exponent>
            ( | e (?&sign) (?&digits) | E (?&sign) (?&digits) ))

        (?<sign>
            ( | \+ | -))

        (?<digit>
            ( 0 | (?&onenine) ))

        (?<onenine>
            ([123456789]))

        (?<string>
            (" (?&characters) ")
            (?{ emit("string", $^N, pos())}))

        (?<characters>
            ( (?&character)* ))

        (?<character>
            ( [^\"\\] | \\ (?&escape) ))

        (?<escape>
            ( \\ | \" | [bfnrt/] | u (?&hex)(?&hex)(?&hex)(?&hex) ))

        (?<hex>
            ( (?&digit) | [abcdefABCDEF] ))

        (?<ws>
            ( ( \x{0020} | \x{000A} | \x{000D} | \x{0009} )* )
            (?{ emit("ws", $^N, pos())}) )
    )
}x;

my %captured;

sub emit ( $token, $content, $endPos ) {
    my $beginPos = $endPos - length($content);
    return if $beginPos == $endPos;
    my $old = $captured{$beginPos}{$token};

    if ( !$old || ( $endPos > $old->[0] ) ) {
        $captured{$beginPos}{$token} = [ $endPos, $content ];
    }
}

sub linearize ($captured) {
    return [
        sort { $a->[0] <=> $b->[0] } map {
            my $beginPos = $_;
            my ( $token, @extra ) = keys %{ $captured->{$beginPos} };
            die "Unexpected extra stuff" if (@extra);

            my ( $endPos, $content ) =
              @{ $captured->{$beginPos}{$token} }[ 0, 1 ];

            [ $beginPos, $endPos, $token, $content ]
        } keys %$captured
    ];
}

my $filename = $ARGV[0] or die "A file name please.";
my $json     = read_file( $ARGV[0] );

unless ( $json =~ m{ (?&JSON)  $JSON_GRAMMAR }gx ) {
    die "Not matched";
}

my @tokenEvents =  @{ linearize( \%captured ) };
#=> Array[ [ beginPos, endPos, token, content ] ]
...

可看到 $JSON_GRAMMAR 變長很多。爲求易讀，加了不少空白與縮排。希望多多少少可以讓人望文生義(笑)。

其中常常出現的 $^N 的這個特殊變數裝的是「前面那個括號所比對到的部分」，也就是實際上 JSON 文件中各個 token 的內容。而 pos() 則是「目前正規表示式引擎的遊標位置」，也就「前面那個括號所比對到的部分的最後一個字符的位置」。

最後做得的 @tokenEvents 則是一個陣列，其內容是依照位置由前到後排序好的 token 列表。每個 token 之間不重疊。

這個 @tokenEvents 的製作過程之所以不那麼容易的另一個原因，是 (?{ ... }) 內程式碼的呼叫頻率。由於正規表示式引擎在執行過程中一定會進行回溯，對應到同一個 token 的 emit() 其實會被呼叫好幾次。對於每個 token 而言，其 emit() 的最後一次呼叫，才代表了解析完畢的最終結果。所以必須要先在 emit() 函式內把每個位置出現的 token 全部記錄下來（記錄在 %captured 變數內），等到全文解析完畢之後，再將記錄轉換成爲 @tokenEvents。

總之，那麼就可以拿 @tokenEvents 來做一些簡單的編譯器。比方說一下這個編譯器會將 JSON 內容中的空白字符去掉，並將所有字串以 rot13 演算法處理：

sub rot13 ($s) {
    $s =~ tr/abcdefghijklmnopqrstuvwxyz/nopqrstuvwxyzabcdefghijklm/;
    $s =~ tr/ABCDEFGHIJKLMNOPQRSTUVWXYZ/NOPQRSTUVWXYZABCDEFGHIJKLM/;
    return $s;
}

for my $event (@tokenEvents) {
    my ( $beginPos, $endPos, $token, $content ) = @$event;

    next if $token eq "ws";

    if ($token eq "string") {
        $content = rot13($content);
    }

    print($content);
}

讓原本是這樣的 JSON 文件：

{
    "greeting": ["Hello World"]
}

變成這樣：

{"terrgvat":["Uryyb Jbeyq"]}

而如果所要做得編譯器必須依賴語法樹，那就更加麻煩了。

雖然這個做法是可行的，但其實不算太簡單，必須理解不少細節才能夠完全正確地寫出能用的編譯器。而且可能不太好延伸。但畢竟一般來說寫編譯器本來就是件複雜度比較高的題目。或許跟以 parser generator 來做編譯器的方法相比的話，複雜度其實相差不多。至少，若有某個現成的 emit() 共通用，能夠用來輔助做出完整語法樹的話，就能讓編譯器的製作省點力氣。

後記：依照 Randal Schwartz Schwartz (merlyn) 在 2012 年首次發表的 "JSON parser as a single Perl Regex" 這篇文章內的 $FROM_JSON 來看，可以透過特殊變數 $^R 與正規表示式引擎的回溯是同調的這項特性來將語法樹建立出來。