[Perl]运算符重载 与 表达式抽象语法树转有理数运算

[523066680]

代码： 全选

[5, "+", [[3, "-", 9], "/", 7]]
(29/7)
[[[2, "/", 7], "+", 3], "-", [9, "/", 21]]
(20/7)

其中分数/有理数 有现成的模块 Math::BigRat 和 Number::Fraction。
自己实现部分功能可以熟悉一下重载。

Code: [show] | [select all]

=info

    表达式抽象语法树 转 有理数运算

    523066680/vicyang

    2019-04

=cut



use feature 'say';

use Data::Dump qw/dd/;

STDOUT->autoflush(1);



my $exp1 = [ 5, '+', [[ 3, '-', 9 ], '/', 7 ]];

my $exp2 = [[[2,'/',7], '+', 3], '-', [9, '/', 21]];

dd $exp1;

say extract( $exp1, 0 );



dd $exp2;

say extract( $exp2, 0 );



sub extract

{

    my ($exp, $lv) = @_;

    my $ret;

    for my $e ( @{$exp}[0,2] ) {

        $e = ref $e ? extract( $e, $lv+1 ) : fract->new($e, 1);

    }

    eval( "\$ret = \$exp->[0] $exp->[1] \$exp->[2]" );

    return $ret;

}



{

    package fract;

    use overload '+' => \&add, '-' => \&sub, 

                 '*' => \&mul, '/' => \&div, 

                 q("") => \&as_string; #sub { return $_[0] };



    sub new {

        my ($class, $n, $m) = @_;

        bless [$n, $m], $class;

    }



    sub add {

        my ($a, $b) = @_;

        my $n = $a->[0]*$b->[1] + $b->[0]*$a->[1];

        my $m = $a->[1]*$b->[1];

        return bless [$n, $m], ref($a);

    }



    sub sub {

        my ($a, $b) = @_;

        my $n = $a->[0]*$b->[1] - $b->[0]*$a->[1];

        my $m = $a->[1]*$b->[1];

        return bless [$n, $m], ref($a);

    }



    sub mul {

        my ($a, $b) = @_;

        my $n = $a->[0]*$b->[0];

        my $m = $a->[1]*$b->[1];

        return bless [$n, $m], ref($a);

    }



    sub div {

        my ($a, $b) = @_;

        my $n = $a->[0]*$b->[1];

        my $m = $a->[1]*$b->[0];

        return bless [$n, $m], ref($a);

    }



    sub as_string {

        my ($f) = @_;

        reduce($f);

        return sprintf "(%d/%d)", $f->[0], $f->[1];

    }



    sub reduce {

        my ($f) = @_;

        my ($a, $b) = @$f;

        while ( $b != 0 ) {

            my $t = $b;

            $b = $a % $b;

            $a = $t;

        }

        $f->[0] /= $a;

        $f->[1] /= $a;

    }



    1;

}

[rubyish2]

很少的機會使用 package
贊~

[523066680]

很少的機會使用 package
贊~

以前以为运算符重载很复杂，现在一用感觉很方便，克服心理障碍比较重要，哈哈。