实现一个简单的计算器

小标题：一个计算器引发的血案！

故事：

        几个星期前，我和我的小伙伴一起去华联超市买东西。它想去买菜，我想去买零食，我们说好了不买其他东西。不幸的是，我们高高兴兴的从超市的一楼逛到三楼的时候，小车已经不能装下更多的东西了。我们互喷了一句，很不高兴的付了账，很高兴的把东西搬了回去。

        当回去分赃的时候，我发现一个问题：我的小伙伴刷卡付账，这意味着我必须把钱给他。尽管我非常不想给它钱，但是还是要给它钱。我拿出账单的时候，惊呆了：账单密密麻麻足足有两米！这是不是意味着，等我算清楚的时候，小伙伴已经老死了。当然，聪明的我决不会用手指算这种垃圾。本人经过慎重研究，考虑到计算的重复性特征，决定采用21世纪西方最先进的计算机技术，完成小伙伴死之前还它钱的伟大壮举！

       于是就又有了这个看起来不牛叉，实际上也不牛叉的计算器！We call it Calc-V1。

 

       用法：输入一串加减乘除的四则运算表达式，得到这个表达式的结果。

       输入：合法的四则运算表达式，包括：+ - * / () 和取反；识别整数、十六进制数、小数（不包括科学计数法格式）

       输出：计算结果（小数或者整数）

       要求：正确计算+ - * / () 取反，正确识别整数、小数（不包括科学计数法，因为华联超市的账单上没有使用科学计数法）。不识别不正确的表达式。

       分析：四则运算的计算机实现一点都不难，因为计算机本身就支持四则运算中的所有操作（+-*/），这里的主要问题是如何正确识别运算优先级，从而正确计算结果。

 

       优先级无非是：先乘除后加减，先括号后外边。

 

       如果用推导式表达的话（参考编译原理的书籍），如下：

Expression >> expression + add-item

Expression >> expression - add-item

Expression >> add-item

Add-item >> add-item * multi-item

Add-item >> add-item / multi-item

Add-tiem >> multi-item

Multi-item >> number

Multi-item >> (expression)

Multi-item >> -(expression)

Multi-item >> +(expression)

       这个文法（推导系统）是左递归的，消除左递归后，可以被自上而下的LL(1)分析所识别（参考编译原理）。如下(null代表空)：

Expression >> add-item add-expression

Add-expression >> + add-item add-expression

Add-expression >> - add-item add-expression

Add-expression >> null

Add-item >> multi-item multi-expression

Multi-expression >> * multi-item multi-expression

Multi-expression >> / multi-item multi-expression

Multi-expression >> null

Multi-item >> number

Multi-item >> (expression)

Multi-item >> -(expression)

Multi-item >> +(expression)

       可以构造LL(1)分析表来识别合法的四则运算表达式，然后使用语法制导翻译，解决四则运算优先级问题。（注：虽然我没有成功，语义分析做不下去了，但是这个方法肯定是可以的，只是语义计算可能有点复杂。）

 

       作为一个正常的人，遇到这样的语义问题，肯定会放弃，就和我做的一样。放弃后，我唯一觉得不开心的是：不就是计算加减乘数吗，上帝有必要把它搞这么复杂吗？

       人类一思考，上帝就发笑。就在我觉得这事情不可理喻的时候，脑子里突然一道灵光：我找到了，就像牛顿头上的烂苹果。所谓伟大的。。。

       其实，事情是这样的，大概在很多个日子之前，有个什么物质（文章、或者中国人）提过到如何用栈实现有优先级的四则运算。大致的思路是：维护一个操作数的栈和运算符号的栈，如果当前读取到的运算符号比较性感，就会吸引该运算符前面的操作数，使它不会投入到前一个运算符的怀抱；相反，如果当前运算符看起来非常屌丝，就会吓跑它前面的操作数，使该操作数和前一个运算符结合。

       例如：1+2+3，Calc-V1会一直读取操作数和运算符，直到读取到第二加号时，奇妙的事情就发生了，这个加号和第一个加号是同一个优先级的，也就是说他们长得一样帅，于是第二个加号先生让我们的2小姐很不高兴：不仅长得丑，约会还迟到，屌丝！于是2就和第一个加号牵手，和1完成了加法运算，计算结果放回原位置，变成3+3。

       再比如：1+2*3，Calc-V1会一直读取操作数和运算符，直到读取到*时，奇妙的事情就发生了。*可不是臭加号，它拥有钻石的外表，高富帅的风度。2小姐当然不是傻子，她甩开哪怕是先到的加号先生的手，毅然决然的奔向*哥哥！当然，3还没有到来，不过天已经注定了他和2小姐的爱情！

       所以四则运算就是谁帅谁性感的问题，真是俗！

 

       下面是代码，为了方便（不是为了‘方便’，你们太邪恶了），采用perl语言，脚本语言都很好理解，没学过也照样看得懂。如果想改写成其他语言，照葫芦画瓢就好了。

       说明：在完成屌丝和高富帅的战争之前，有一个简单的词法分析，也就是程序把一个表达式识别成一个个的单词，而不是一个个字符。比如：123+234，应该是’123’和’+’和’234’，而不是1和2和3等等。解释注释都是掩饰，上代码！

#!/usr/bin/perl -w
### tools func ###
$local_debug = 1;
sub Info($){ print "[INFO ]@_\n"; }
sub Die($) { die "@_\n"; }
sub Err($) { print "[ERROR]@_\n"; }
sub De($)  { $local_debug == 0 or print "[DEBUG]@_\n"; }
### end        ###

### global variables
@buf = ();#the string char buffer 
@back = ();# the unused token 
$status = "value";# the status of the operation
@stack = ();# the stack to keep operators and numbers
$base = 0;# the base priority of new tokens
$offset = 3;# the priority of an () will improved
$unary_op = "";# the unary + or -, to support +12, -4.5 
### global variables

### main start
if(@ARGV > 0){#read from cmd line
    $string = join("",@ARGV);
    $res = &calc($string);
    print "=$res\n";
}else{
    while(<STDIN>){#read from pipeline or cmd line
        if(/^\s*$/ or /^#/ ){ next; }
        $res = &calc($_);
        print "$res=$_\n";
    }   
}
exit;
### main end 
                                                                                                                                                                                 
### define
# operator: + - * / +( -( ( )  #
# priority: 0 0 1 1 2  2  2 2  -1
# the '#' is the end of token string
# number: int[12 13 15] float:[0.1 1.1 1. ] hex[0x00 0X0F]
# token attribute: + - op_plus, * / op_multi, ( +( -( op_left, ) op_right, int num_int, float num_float, hex num_hex
### end define

sub calc{
    if( @_ == 0){ return ;}
    my $string = shift@_;

    #init 
    @buf = split(//, $string);
    $status = "value";# the status transfer table: value -> operator, operator -> value, value -> number -> operator
    @back = ();#buffer the unused token 

    @stack = ();#all operators and numbers are inserted in this stack
    @priority = ();#all token's priority are inserted in this stack 
    $base = 0;
    $unary_op = "";
    #run
    while(1){#status transfer machine 
        De "stats: $status";
        my @token = &get_token();
        if( $token[1] eq "ERROR"){ Die "unexpected char:$token[0]"; }
        De "token:@token";
        if($status eq "value"){ &actionValue(@token);}
        elsif($status eq "number"){ &actionNumber(@token); }
        elsif($status eq "operator"){ &actionOperator(@token);}
        elsif($status eq "end"){ last; }
        else{ Die "unexpected status:$status"; }
        De "stack:@stack";
        #De "prior:@priority";
    }
    return $stack[0];
}
sub get_priority{
    my $a = $_[0];
    if($a eq "+" or $a eq "-"){ return 0; }
    elsif($a eq "*" or $a eq "/"){ return 1; }
    elsif($a =~ /\(/ or $a eq ")" ){ return 2; }
    elsif($a eq "#"){ return -1; }
    else{ Die "bad token to ask for priority:$a"; }
}
sub actionValue{
    my($token, $attr) = @_;
    if( $attr =~ /^num/ ){
        $token = $attr eq "num_hex" ? hex($token) : 1*$token;
        push@stack, $token;
        push@priority, 0;#the number's priority is ignored
        $status = "operator";
    } elsif ( $token eq "+" || $token eq "-" ){
        $unary_op = $token;# needs a number to build a value, +12,-2.3 etc.
        $status = "number";
    } elsif ( $token eq "+(" || $token eq "-(" || $token eq "("){
        push@stack, $token;
        push@priority, $base+&get_priority($token);
        $base += $offset;#improve the priority
        $status = "value";#alse needs a value 
    }else{ Die "unexpected token: $token, where needs a value or its prefix:+-"; }
}
sub actionNumber{
    my($token, $attr) = @_;
    if( $attr =~ /^num/ ){
        $token = $attr eq "num_hex" ? hex($token) : 1*$token;
        if($unary_op eq "-"){ $token = -1*$token; }
        elsif($unary_op eq "+"){}
        else{ Die "unexpected unary operator:$unary_op"; }
        push@stack, $token;
        push@priority, 0; # the number's priority is ignored 
        $status = "operator";
    }else{
        Die "unexpected token: $token, where needs a number for its prefix:$unary_op";
    }
}
sub actionOperator{
    my($token, $attr) = @_;
    if ( $token eq "+" || $token eq "-" || $token eq "*" || $token eq "/"){
        if(&actionCalc($token) eq "no_action"){# no action means to shift in the token
            push@stack, $token;
            push@priority, $base+&get_priority($token);
            $status = "value";
        }else{ #the action will change the status in the @stack, use the same token try again 
            @back = ($token, $attr);
            $status = "operator";
        }
    } elsif ( $token eq ")" ){
        if(&actionCalc($token) ne "matched"){
            @back = ($token, $attr);
        }else{
            $base -= $offset;
            $base >=0 or Die "two many ')'";
        }
        $status = "operator";
    } elsif( $token eq "#"){#means the end of the string 
        $base == 0 or Die "unexpected end of calc string, needs more right parentheses";
        if(&actionCalc($token) eq "no_action"){
            @stack == 1 or Die "bad end of stack:@stack";
            $status = "end";
        }else{
            @back = ($token, $attr);
            $status = "operator";
        }
    }else{ Die "unexpected token: $token, where needs an op"; }
}
sub actionCalc{
    my $next_operator = $_[0];
    my $next_priority = $base + &get_priority($next_operator);
    $next_priority -= $next_operator eq ")" ? $offset : 0;
    if(@stack < 3){ return "no_action"; }#at least has this pattern: number operator number 
    my $current_priority = $priority[-2];# get the last operator
    if($current_priority >= $next_priority){
        if(&is_binary_op($stack[-2])){
            my $value = &oneOPtwo($stack[-3], $stack[-2], $stack[-1]);
            pop@stack;pop@stack;pop@stack;push@stack, $value;
            pop@priority;pop@priority;pop@priority;push@priority,0;
            return "calc";
        }elsif( &is_left_parentheses($stack[-2])){
            my $value = pop@stack;
            my $op = pop@stack;
            $value = $op eq "-(" ? -1*$value : $value;
            push@stack, $value;
            pop@priority;pop@priority;push@priority,0;
            return "matched";
        }else{ Die "bad stack content at:$stack[-2]"; }
    }else{ return "no_action"; }
}
sub is_binary_op{
    my $op = shift@_;
    return $op eq "+" || $op eq "-" || $op eq "*" || $op eq "/";
}
sub is_left_parentheses{
    my $op = $_[0];
    return $op eq "+(" || $op eq "-(" || $op eq "(";
}
sub oneOPtwo{
    my($one, $op, $two) = @_;
    De "calc : $one $op $two";
    my $res = 0;
    if( $op eq "+" ){ $res = $one + $two; }
    elsif( $op eq "-" ){ $res = $one - $two; }
    elsif( $op eq "*" ){ $res = $one * $two; }
    elsif( $op eq "/" ){ $res = $one / $two; }
    else{ Die "bad op : $op"; }
    return $res;
}
### end 

### token func
sub get_token{
    my @token = ("#", "#");
    if( @back != 0 ){ 
        @token = @back;
        @back = ();
        return @token;
    }
    #ignore whitespace 
    while( @buf > 0 && &is_whitespace($buf[0]) ){ shift@buf; }
    if( @buf > 0){
        my $ch = shift@buf;
        if( $ch eq "+" || $ch eq "-" ){ 
            if( @buf > 0 && $buf[0] eq "(" && $status eq "value"){ 
                shift@buf;                                                                                                                                                        
                @token = ("$ch(", "op_left");
            }else { @token = ($ch, "op_plus"); }
        }elsif( $ch eq "*" ){ @token = qw(* op_multi); }
        elsif( $ch eq "/" ){ @token = qw(/ op_multi); }
        elsif( $ch eq "(" ){ @token = qw%( op_left%; }
        elsif( $ch eq ")" ){ @token = qw%) op_right%; }
        elsif( &is_digit($ch) ){ @token = &get_digit($ch); }
        else { Err "unexpected char: '$ch'"; @token = ($ch, "ERROR");}
    }
    return @token;
}
sub get_digit{
    my @num = ();
    push@num, $_[0];
    # handle hex-format: 0x00
    if( $num[0]  eq "0" && @buf > 1 && ($buf[0] eq "x" || $buf[0] eq "X") && &is_hexdigit($buf[1]) ){
        shift@buf;
        @num = qw(0 x);
        while( @buf > 0 && &is_hexdigit($buf[0]) ){ 
            push@num, $buf[0];
            shift@buf;
        }
        my $token = join "", @num;
        return ($token, "num_hex");
    }
    while( @buf > 0 && &is_digit($buf[0]) ){
        push@num, $buf[0];
        shift@buf;
    }
    # if is not .
    if( @buf == 0 || @buf > 0 && $buf[0] ne "." ){
        my $token = join "", @num;
        return ($token, "num_int");
    }
    # handle .
    push@num, $buf[0];
    shift@buf;
    while( @buf > 0 && &is_digit($buf[0]) ){
        push@num, $buf[0];
        shift@buf;
    }
    my $token = join "", @num;
    return ($token, "num_float");
}
sub is_whitespace{
    my $ch = $_[0];
    return $ch eq " " || $ch eq "\t" || $ch eq "\n" || $ch eq "\f" || $ch eq "\r" ;
}
sub is_digit{
    my $ch = $_[0];
    return $ch eq "0" || $ch eq "1" || $ch eq "2" || $ch eq "3" || $ch eq "4" 
        || $ch eq "5" || $ch eq "6" || $ch eq "7" || $ch eq "8" || $ch eq "9";
}
sub is_hexdigit{
    my $ch = $_[0];
    return $ch eq "0" || $ch eq "1" || $ch eq "2" || $ch eq "3" || $ch eq "4"
        || $ch eq "5" || $ch eq "6" || $ch eq "7" || $ch eq "8" || $ch eq "9"
        || $ch eq "a" || $ch eq "b" || $ch eq "c" || $ch eq "d" || $ch eq "e" || $ch eq "f"
        || $ch eq "A" || $ch eq "B" || $ch eq "C" || $ch eq "D" || $ch eq "E" || $ch eq "F";
}

 

       有了这个神器，妈妈再也不用担心我的学习了。开玩笑。有了这个Calc-V1，以后再也不用担心计算中途的时候，该死的鼠标点错了啊（是不是很开心）。

 

       故事结局：当我找出编译原理的书，倒腾出推导式，消除左递归，完成LL分析发现困难重重，又被烂苹果砸到脑袋，采用perl，在linux下完成编码和测试，最后计算出正确答案的时候，悄悄的，北京的房价又涨了几千，人民币又贬值了几块，太阳东升西落了几次。

       微风吹开我的长发，我拿着写着结果的纸片，轻盈的走向我的小伙伴，它，它，它，居然不理我了！不理我了！居然不理我了！！！（旁观者眼中：主角得不到小伙伴的认可，吐血身亡。）

 

       画外音：天才都短命。珍爱生命，远离天才。