#-------------- Testing framework first, so we can test immediately
set verbose [expr {[lsearch $argv -v] >= 0}]
set N 0
set Nfail 0
proc e.g. {cmd -> expected} {
    incr ::N
    catch {uplevel 1 $cmd} res
    if {$res ne $expected} {
        puts [list ($::N) $cmd -> $res ***** expected $expected]
        incr ::Nfail
    } elseif $::verbose {puts [list ($::N) $cmd -> $res]}
}
#------------------------------------------------------- real stuff

proc typeof char {
    switch -- $char {
        0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - . {return digit}
        + - "-" - * - / - ( - ) {return op}
        default {error "bad character $char"}
    }
}
e.g. {typeof 7} -> digit
e.g. {typeof .} -> digit
e.g. {typeof *} -> op
e.g. {typeof ?} -> {bad character ?}

#----------------------------------------------------------------
proc tokenize str {
    set res ""
    set previous ""
    set parens 0
    foreach char [split $str ""] {
        if {$char eq "("} {incr parens; append res " "}
        if {$char eq ")"} {incr parens -1}
        if {$char eq " "} continue
        set type [typeof $char]
        if {$previous ne "" && $type ne $previous} {append res " "}
        set previous $type
        append res $char
        if {$char eq ")"} {append res " "}
    }
    if $parens {error "unmatched parens $parens"}
    string trim $res
}
e.g. {tokenize 2+3} -> {2 + 3}
e.g. {tokenize "2 + 3"} -> {2 + 3}
e.g. {tokenize "2 + (3)"} -> {2 + ( 3 )}
e.g. {tokenize 12+43} -> {12 + 43}
e.g. {tokenize (} -> {unmatched parens 1}
e.g. {tokenize )} -> {unmatched parens -1}


#----------------------------------------------------------------- Stack
proc pop {{_stack ""}} {
    if {$_stack eq ""} {set _stack ::S} ;# default: global stack
    upvar 1 $_stack stack
    K [lindex $stack end] [set stack [lrange $stack 0 end-1]]
}
proc K {a b} {set a}

proc push what {lappend ::S $what}

e.g. {push hello; set S} -> hello
e.g. {pop; set S} -> {}

#----------------------------------------------------------------- Parser
proc parse tokens {
    #puts [info level 0]
    set res {}
    set opstack {}
    set braces 0
    set recurs {}
    foreach token $tokens {
        if $braces {
            lappend recurs $token
            if {$token eq "("} {incr braces}
            if {$token eq ")"} {
                incr braces -1
                if {$braces == 0} {
                    eval lappend res [parse [lrange $recurs 0 end-1]]
                    set recurs {}
                }
            }
        } else {
            if [string is double -strict $token] {
                lappend res [list push $token] 
                if {[llength $opstack]} {lappend res [pop opstack]}
            } elseif {$token eq "("} {
                incr braces
            } elseif {[typeof $token] eq "op"} {
                lappend opstack $token
            }
        }
        #puts token:$token,braces:$braces,recurs:$recurs
    }
    while {[llength $opstack]} {lappend res [pop opstack]}
    set res
}
e.g. {parse "2 + 3"} -> {{push 2} {push 3} +}
e.g. {parse "2 + 3 + 4"} -> {{push 2} {push 3} + {push 4} +}
e.g. {parse "( 2 + 3 ) * 4"} -> {{push 2} {push 3} + {push 4} *}

#----------------------------------------------------------------
foreach op {+ - * /} {
    proc $op {} "set a \[pop\]; push \[expr {\[pop\] $op \$a}\]"
}
e.g. {info body +} -> {set a [pop]; push [expr {[pop] + $a}]}

#----------------------------------------------------------- RPN evaluator
proc rpn cmdlist {
    if $::verbose {puts $cmdlist}
    global S
    foreach cmd $cmdlist {eval $cmd}
    if {[llength $S] != 1} {error "bad stack: $S"}
    pop
}
e.g. {rpn {{push 6} {push 7} *}} -> 42

#----------------------------------------------------------------
proc i2r {expr} {rpn [parse [tokenize $expr]]}

e.g. {i2r 2+3}     -> 5
e.g. {i2r 2/3}     -> 0
e.g. {i2r 1/2.}    -> 0.5
e.g. {i2r 1./2}    -> 0.5
e.g. {i2r 2/0}     -> "divide by zero"
e.g. {i2r 2/3.}    -> 0.666666666667
e.g. {i2r (2+3)*4} -> 20
e.g. {i2r 2+3*4}   -> 20 ;# yes... left-associative, no precedence
e.g. {i2r 2+(3*4)}   -> 14
e.g. {i2r 2+3+4}   -> 9
e.g. {i2r (1+2)*(3+4)} -> 21
e.g. {i2r 2*3+4}   -> 10
e.g. {i2r (2*3)+4}   -> 10
e.g. {i2r (2*3)+(4)}   -> 10
e.g. {i2r 3*(3+4)}   -> 21
e.g. {i2r {3 + ( 4 * ( 5 + 6 ) )}} -> 47


#------------------------------ Final tally
incr N -1 ;# last call to e.g. will incr again
puts ---
e.g. {list $Nfail / $N = [format %.2f [expr 100.*$Nfail/$N]] %} -> 0
puts ""
foreach arg $argv {e.g. $arg -> ?}