文字列の式を計算

カッコも演算子の優先度、単行演算子もあります。 Ruby で書いたのを移植しました。文字列の式をトークンの配列に分解→逆ポーランド記法に変換→計算という段階を踏んでいます。

#module calc_token type, val
#modinit int _type, var _val
    type = _type
    val = _val
    return
#defcfunc calc_token_type modvar calc_token@
    return type
#defcfunc calc_token_val modvar calc_token@
    return val
#global

#module calc

#enum TOKEN_TYPE_NONE = 0
#enum TOKEN_TYPE_BINARY_OPERATOR
#enum TOKEN_TYPE_UNARY_OPERATOR
#enum TOKEN_TYPE_NUM
#enum TOKEN_TYPE_LEFT_BRACKETS
#enum TOKEN_TYPE_RIGHT_BRACKETS

#deffunc init_calc
    binary_operators           = "*", "/", "+", "-"
    binary_operators_priority  =   2,   2,   1,   1
    unary_operators            = "+", "-"
    unary_operators_priority   =   5,   3
    return

#defcfunc calc_operate_binary int operator, double a, double b
    switch operator
    case 0
        return a * b
    case 1
        return a / b
    case 2
        return a + b
    case 3
        return a - b
    swend

#defcfunc calc_operate_unary int operator, double a
    switch operator
    case 0
        return a
    case 1
        return -a
    swend

#deffunc calc_scan_num
    c = char
    if c == '-' : c = peek( expr, i + 1 )
    if c < '0' || c > '9' : return
    type = TOKEN_TYPE_NUM
    size = 1
    find = 1
    repeat
        if i + size >= len : break
        c = peek( expr, i + size )
        if c < '0' || c > '9' : break
        size ++
    loop
    c = peek( expr, i + size )
    if c == '.' {
        c = peek( expr, i + size + 1 )
        if c >= '0' && c <= '9' {
            size ++
            repeat
                if i + size >= len : break
                c = peek( expr, i + size )
                if c < '0' || c > '9' : break
                size ++
            loop
        }
    }
    val = double( strmid( expr, i, size ) )
    return

#deffunc calc_scan_operator array operators
    foreach operators
        dup operator, operators.cnt
        if strmid( expr, i, strlen( operator ) ) == operator {
            size = strlen( operator )
            val = cnt
            find = 1
            break
        }
    loop
    return

#deffunc calc_lex str _expr
    expr = _expr
    dimtype tokens, 5
    prev_type = TOKEN_TYPE_NONE
    i = 0
    len = strlen( expr )
    find = 1
    repeat
        if i >= len : break
        char = peek( expr, i )
        switch char
        case ' ' : case 0x09 : case 0x0a
        case 0x0d : case 0x0c
            i ++
            continue
        swend
        find = 0 : size = 0 : type = TOKEN_TYPE_NONE : val = 0
        switch prev_type
        case TOKEN_TYPE_NONE : case TOKEN_TYPE_LEFT_BRACKETS
        case TOKEN_TYPE_BINARY_OPERATOR : case TOKEN_TYPE_UNARY_OPERATOR
            calc_scan_num
            if find : swbreak
            calc_scan_operator unary_operators
            if find : type = TOKEN_TYPE_UNARY_OPERATOR : swbreak
            if char == '(' {
                type = TOKEN_TYPE_LEFT_BRACKETS
                size = 1
                find = 1
                swbreak
            }
            swbreak
        case TOKEN_TYPE_NUM : case TOKEN_TYPE_RIGHT_BRACKETS
            calc_scan_operator binary_operators
            if find : type = TOKEN_TYPE_BINARY_OPERATOR : swbreak
            if char == ')' {
                type = TOKEN_TYPE_RIGHT_BRACKETS
                size = 1
                find = 1
                swbreak
            }
        swend
        if find == 0 : break
        newmod tokens, calc_token, type, val
        prev_type = type
        i += size
    loop
    if find == 0 {
        error = "構文エラーです"
        return 1
    }
    return 0

#deffunc calc_insert_rpn_tokens
    i = rpn_tokens_size
    repeat
        if i <= rpn_tokens_ptr : break
        rpn_tokens( i ) = rpn_tokens( i - 1 )
        i --
    loop
    rpn_tokens( rpn_tokens_ptr ) = token
    rpn_tokens_size ++
    return

#defcfunc calc_is_token_operator var t
    if calc_token_type( t ) == TOKEN_TYPE_BINARY_OPERATOR : return 1
    if calc_token_type( t ) == TOKEN_TYPE_UNARY_OPERATOR  : return 1
    return 0

#defcfunc calc_operator_token_prioririty var t
    if calc_token_type( t ) == TOKEN_TYPE_BINARY_OPERATOR {
        return binary_operators_priority( calc_token_val( t ) )
    }
    return unary_operators_priority( calc_token_val( t ) )

#defcfunc calc_rop_is_end
    if rs_stack_ptr <= 0 : return 0
    if rs_stack( rs_stack_ptr - 1 ) != brackets_level : return 0

    if rpn_tokens_ptr >= rpn_tokens_size : return 1
    token1 = rpn_tokens( rpn_tokens_ptr )
    if tokens_i + 1 >= length( tokens ) : return 1
    token2 = tokens( tokens_i + 1 )

    if calc_is_token_operator( token1 ) == 0 : return 1
    if calc_is_token_operator( token2 ) == 0 : return 1

    token1p = calc_operator_token_prioririty( token1 )
    token2p = calc_operator_token_prioririty( token2 )

    return token2p <= token1p

#deffunc calc_rop_exit
    while calc_rop_is_end()
        rs_stack_ptr --
        rpn_tokens_ptr ++
    wend
    return

#deffunc calc_convert_to_rpn
    ret = 0
    dimtype rpn_tokens, 5
    rpn_tokens_size = 0
    rpn_tokens_ptr = 0
    prev_type = TOKEN_TYPE_NONE
    dim rs_stack
    rs_stack_ptr = 0
    brackets_level = 0

    foreach tokens
        tokens_i = cnt
        dup token, tokens.cnt
        type = calc_token_type( token )
        switch type
        case TOKEN_TYPE_NUM
            calc_insert_rpn_tokens
            rpn_tokens_ptr ++
            if prev_type == TOKEN_TYPE_BINARY_OPERATOR || prev_type == TOKEN_TYPE_UNARY_OPERATOR {
                calc_rop_exit
            }
            swbreak
        case TOKEN_TYPE_BINARY_OPERATOR
        case TOKEN_TYPE_UNARY_OPERATOR
            calc_insert_rpn_tokens
            rs_stack.rs_stack_ptr = brackets_level
            rs_stack_ptr ++
            swbreak
        case TOKEN_TYPE_LEFT_BRACKETS
            brackets_level ++
            swbreak
        case TOKEN_TYPE_RIGHT_BRACKETS
            if brackets_level <= 0 {
                error = "不正な閉じカッコです"
                ret = 1
                break
            }
            brackets_level --
            calc_rop_exit
            swbreak
        default
            error = "不明なトークンです"
            ret = 1
            break
        swend
        prev_type = type
    loop
/*  デバッグ表示
    repeat rpn_tokens_size
        if calc_token_type( rpn_tokens.cnt ) == TOKEN_TYPE_BINARY_OPERATOR {
            mes binary_operators( calc_token_val( rpn_tokens.cnt ) )
        } else : if calc_token_type( rpn_tokens.cnt ) == TOKEN_TYPE_UNARY_OPERATOR {
            mes unary_operators( calc_token_val( rpn_tokens.cnt ) )
        } else {
            mes calc_token_val( rpn_tokens.cnt )
        }
    loop */
    if ret : return ret
    if rpn_tokens_ptr != rpn_tokens_size {
        error = "式が途中で終了しています"
        return 1
    }
    if brackets_level != 0 {
        error = "カッコが閉じられていません"
        return 1
    }
    return 0

#deffunc calculate_rpn var result
    ddim stack, 1
    stack_ptr = 0
    ret = 0
    foreach rpn_tokens
        dup token, rpn_tokens.cnt
        type = calc_token_type( token )
        switch type
        case TOKEN_TYPE_NUM
            stack.stack_ptr = calc_token_val( token )
            stack_ptr ++
            swbreak
        case TOKEN_TYPE_BINARY_OPERATOR
            if stack_ptr < 2 {
                error = "オペランドが足りません"
                ret = 1
                break
            }
            stack_ptr --
            _b = stack.stack_ptr
            stack_ptr --
            _a = stack.stack_ptr
            stack.stack_ptr = calc_operate_binary( calc_token_val( token ), _a, _b )
            stack_ptr ++
            swbreak
        case TOKEN_TYPE_UNARY_OPERATOR
            if stack_ptr < 1 {
                error = "オペランドが足りません"
                ret = 1
                break
            }
            stack( stack_ptr-1 ) = calc_operate_unary( calc_token_val( token ), stack( stack_ptr-1 ) )
            swbreak
        default
            error = "不明なトークンです"
            ret = 1
            break
        swend
    loop
    if ret : return ret
    if stack_ptr != 1 {
        error = "オペランドが足りないか、余っています"
        return 1
    }
    result = stack.0
    return 0

#deffunc calculate str _expr, var result
    calc_lex _expr
    if stat : return stat
    calc_convert_to_rpn
    if stat : return stat
    calculate_rpn result
    return stat

#global
init_calc

exprs = "1+2*(3+4)", "1+--1", " ( 1 + ( 2 + ( 3 ) ) )", "2.5/-1.2", "1+", "((", "()", ""
foreach exprs
    expr = exprs.cnt
    mes expr
    calculate expr, result
    if stat {
        mes "Error: "+error@calc
    } else {
        mes " = " + result
    }
loop