メメメモモ

プログラミング、筋トレ、ゲーム、etc

構文解析器

前回は、抽象構文木をプログラム直打ちで記述していました。
今回は、下記のスクリプト文字列を読み込んで、抽象構文木を作成する構文解析器を作成しました。

n=5;x=1;L5{x=x*n;n=n-1};x'


スクリプトの構文解析を行なうためには、
まずスクリプトの構文がどのような構造をしているのかを知る必要があります。
今回のスクリプトは以下の構文に従っているものとして解析しています。

prog ::= stat | stat ';' prog
stat ::= '{' prog '}' | 'L' expr stat | expr
expr ::= fact | fact '+' expr | fact '-' expr | fact '*' expr | fact '/' expr | fact '=' expr
fact ::= identfier | number | '(' expr ')'


構造の定義は、BNF記法というものを使用して記述しました。
例えば「数字」はどのように構成されているのかを表すには、下記のように書きます。

数字 ::= 0|1|2|3|4|5|6|7|8|9


ということで、構文の構造の定義を基にプログラムを書きます。
スクリプト文字列を読み込んで、一字一字読み進めていくメソッドなどを定義した「Lexer」モジュールと、構文解析用の関数を定義しています。

package Lexer;
use strict;
use warnings;

sub new {
    my $class = shift;
    my ($s) = @_;

    my @str = ();
    while ($s =~ /(.)/g) {
        push @str, $1;
    }
    push @str, '$';

    bless { str => \@str, pos => 0 }, $class;
}


sub peek {
    my $self = shift;
    my $pos = $self->{pos};
    return $self->{str}->[$pos];
}



sub fwd {
    my $self = shift;
    my $str_length = @{$self->{str}};

    if ($self->{pos} < $str_length-1 ) {
        $self->{pos} += 1;
    }

    $self;
}


sub to_s {
    my $self = shift;
    my @str = @{$self->{str}};
    my $pos = $self->{pos};
    return @str[0..$pos-1] . '!' . @str[$pos..-1];
}


1;


package main;

sub prog {
    my $sc = shift;

    my $s = state($sc);
    my $c = $sc->peek();

    if ($c eq '$' || $c eq '}') {
        return $s;
    } elsif ($c eq ';') {
        $sc->fwd();
        return Seq->new($s, prog($sc));
    } else {
        print'STAT:'.$sc->to_s()."\n";
        return Noop->new();
    }
}


sub state {
    my $sc = shift;

    my $c = $sc->peek();

    if ($c eq '{') {
        $sc->fwd();
        my $p = prog($sc);
        if ($sc->peek() ne '}') {
            print 'NO_}:'.$sc->to_s()."\n";
            return Noop->new();
        }
        $sc->fwd();
        return $p;
    } elsif ($c eq 'L') {
        $sc->fwd();
        my $e = expr($sc);
        return Loop->new($e, state($sc));
    } else {
        return expr($sc);
    }
}

sub expr {
    my $sc = shift;

    my $e = fact($sc);
    my $c = $sc->peek();

    if ($c eq '+') {
        $sc->fwd();
        return Add->new($e, expr($sc));
    } elsif ($c eq '-') {
        $sc->fwd();
        return Sub->new($e, expr($sc));
    } elsif ($c eq '*') {
        $sc->fwd();
        return Mul->new($e, expr($sc));
    } elsif ($c eq '/') {
        $sc->fwd();
        return Div->new($e, expr($sc));
    } elsif ($c eq '=') {
        $sc->fwd();
        return Assign->new($e, expr($sc));
    } else {
        return $e;
    }
}


sub fact {
    my $sc = shift;

    my $c = $sc->peek();
    $sc->fwd();

    if ($c ge 'a' && $c le 'z') {
        return Var->new($c);
    } elsif ($c >= 0 && $c <= 9) {
        return Lit->new($c);
    } elsif ($c eq ')') {
        my $e = expr($sc);
        if ($sc->peek() ne ')') {
            print 'NO_):'.$sc->to_s()."\n";
            return Noop->new();
        }
        $sc->fwd();
        return $e;
    } else {
        print 'FACTOR:'.$sc->to_s()."\n";
        return Noop->new();
    }
}

my $e = prog(Lexer->new('n=5;x=1;L5{x=x*n;n=n-1};x'));
print $e->to_s(),"\n";
print $e->exec(),"\n";


解析関数の定義とBNFの定義が、ほぼ対応している形になっています。