간단한 사칙연산 언어 인터프리터

lang.pl

use Test::More;
use Data::Dump;

sub compile {
    my @assm;
    my $prg = shift;
    my ( $func, @args ) = @{$prg};
    foreach my $a (@args) {
        if ( ref($a) ne 'ARRAY' ) {
            push( @assm, [ "push", $a ] );
        }
        else {
            my $assm2 = compile($a);
            push( @assm, @{$assm2} );
        }
    }
    push( @assm, [ "call", $func ] );
    dd \@assm;
    return \@assm;
}

my $funcs = {
    one => {
        args => 0,
        sub  => sub { return 1; }
    },
    '+' => {
        args => 2,
        sub  => sub { return $_[0] + $_[1]; }
    },
    '*' => {
        args => 2,
        sub  => sub { return $_[0] * $_[1]; }
    },
    '-' => {
        args => 2,
        sub  => sub { return $_[0] - $_[1]; }
    },
    '/' => {
        args => 2,
        sub  => sub { return $_[0] / $_[1]; }
    },
};

sub call {
    my ($assm) = shift;
    my @stack;
    foreach my $p ( @{$assm} ) {
        if ( $p->[0] eq 'push' ) {
            push( @stack, $p->[1] );
            dd \@stack;
        }
        if ( $p->[0] eq 'call' ) {
            my $spec = $funcs->{ $p->[1] };
            dd $spec;
            my @args;
            foreach my $i ( 0 .. $spec->{args} - 1 ) {
                dd \@stack;
                unshift( @args, pop(@stack) );
            }
            push( @stack, $spec->{sub}->(@args) );
            dd \@stack;
        }
    }
    return pop(@stack);
}

is_deeply( compile( ["one"] ), [ [ "call", "one" ] ] );
is_deeply( compile( [ "+", "1", "2" ] ),
    [ [ "push", "1" ], [ "push", "2" ], [ "call", "+" ] ] );
is_deeply( compile( [ "+", ["one"], "2" ] ),
    [ [ "call", "one" ], [ "push", "2" ], [ "call", "+" ] ] );

is( call( compile( [ "+", ["one"], "2" ] ) ), 3 );
is( call( compile( [ "+", 1, [ "+", 50, 2 ] ] ) ), 53 );
is( call( compile( [ "+", 3, [ "+", 12, ["one"] ] ] ) ), 16 );
is( call( compile( [ "+", 3, [ "-", 12, 2 ] ] ) ),  13 );
is( call( compile( [ "/", 6, [ "-", 12, 10 ] ] ) ), 3 );

done_testing();