メメメモモ

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

抽象構文木構築

下記のスクリプトは、nの階乗を求めることを想定しています。

n = 5;
x = 1; 
L n 
   x = x * n; 
   n = n - 1; 
x;


このスクリプトを構文木の形で表現して実行するプログラムを書きました。
構文木は下記のようなものになります。

f:id:memememomo:20100416201454p:image

プログラムは、木の節点に対して一つのクラスを定義して書いていきました。
節点の種類とクラスの対応付けは下記のようなものにしました。

  • 四則演算(Add, Sub, Mul, Div)
  • 定数(Lit)
  • 変数(Var)
  • 代入(Assign)
  • セミコロン(Seq)
  • ループ(Loop)


プログラムは下記のようになります。

package Node;
use strict;
use warnings;

my %vars;

sub new {
    my $class = shift;
    my ($l, $r) = @_;
    bless { left => $l, right => $r, op => '?' }, $class;
}

sub to_s {
    my $self = shift;
    return
        '(' .
        $self->to_str($self->{left}) .
        $self->to_str($self->{op}) .
        $self->to_str($self->{right}) .
        ')';
}

sub to_str {
    my $self = shift;
    my $ob = shift;

    unless (ref($ob)) {
        return $ob || '';
    } else {
        return $ob->to_s() || '';
    }
}


sub get_left { shift->{left} }
sub get_right { shift->{right} }
sub get_op { shift->{op} }

1;


package Add;
use strict;
use warnings;
use base qw/Node/;

sub new {
    my $class = shift;

    my $self = $class->SUPER::new(@_);
    $self->{op} = '+';
    $self;
}

sub exec {
    my $self = shift;
    return $self->{left}->exec() + $self->{right}->exec();
}

1;

package Sub;
use strict;
use warnings;
use base qw/Node/;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = '-';
    $self;
}

sub exec {
    my $self = shift;
    return $self->{left}->exec() - $self->{right}->exec();
}

1;

package Mul;
use strict;
use warnings;
use base qw/Node/;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = '*';
    $self;
}
sub exec {
    my $self = shift;
    return $self->{left}->exec() * $self->{right}->exec();
}

1;


package Div;
use strict;
use warnings;
use base qw/Node/;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = '/';
    $self;
}

sub exec {
    my $self = shift;
    return $self->{left}->exec() / $self->{right}->exec();
}

1;


package Lit;
use strict;
use warnings;
use base qw/Node/;


sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = '#';
    $self;
}

sub exec {
    my $self = shift;
    return $self->{left};
}

1;


package Var;
use strict;
use warnings;
use base qw/Node/;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = '$';
    $self;
}

sub exec {
    my $self = shift;
    return $vars{$self->{left}};
}

1;


package Assign;
use strict;
use warnings;
use base qw/Node/;


sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = '=';
    $self;
}


sub exec {
    my $self = shift;
    my $v = $self->{right}->exec();
    $vars{$self->{left}->get_left()} = $v;
    return $v;
}

1;


package Seq;
use strict;
use warnings;
use base qw/Node/;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = ';';
    $self;
}


sub exec {
    my $self = shift;
    $self->{left}->exec();
    return $self->{right}->exec();
}

1;


package Loop;
use strict;
use warnings;
use base qw/Node/;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{op} = 'L';
    $self;
}

sub exec {
    my $self = shift;
    my $v = 0;
    my $loop_num = $self->{left}->exec();
    for (my $i = 0; $i < $loop_num; $i++) {
        $v = $self->{right}->exec();
    }
    return $v;
}

1;


package Noop;
use strict;
use warnings;
use base qw/Node/;


sub exec { return 0; }
sub to_s { return '?'; }


1;


package main;
use strict;
use warnings;

my $e = Seq->new(
    Assign->new(Var->new('n'), Lit->new(5)),
    Seq->new(
        Assign->new(Var->new('x'), Lit->new(1)),
        Seq->new(
            Loop->new(
                Var->new('n'),
                Seq->new(
                    Assign->new(Var->new('x'), Mul->new(Var->new('x'),
                                                        Var->new('n'))),
                    Assign->new(Var->new('n'), Sub->new(Var->new('n'),
                                                        Lit->new(1))))),
            Var->new('x'))));


print $e->to_s(),"\n";
print $e->exec(),"\n";


スクリプト実行結果である「120」が表示されます。