gistfile1.ph

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";