RPN Calculator in Tcl

The below presented program is a loop that calls the gets command to read lines from the standard input until there are no more. A line is processed by first removing all leading and trailing blanks from it, using string trim. Then it gets split into a list tks of tokens. If the input line was empty, tks is empty as well, so the expression evaluation is skipped for that line. For non-empty lines, the st variable is used as a stack for intermediate values and is therefore initialized to an empty list.

The inner, foreach loop, iterates over the sequence of tokens. Note that there may be empty tokens in tks, due to split creating a token between any two blanks. If a token, tk, is non-empty, it is checked for being a number. If it is one, it gets pushed onto st. Adding a real-valued zero just before the push ensures that the number is stored as floating-point, lest a division operation should produce an integer (inaccurate) quotient, which it would do with integer arguments.

A non-number token is matched against the set of the four arithmetic operator characters. If tk is an operator and there are at least two numbers on st, the topmost two of them are replaced by the result of computing the corresponding operation. eval is used for that computation. (Because that command is a long one, it has to be split into two parts; the point of split is marked with the \ character.) If tk is none of the two acceptable token kinds, or if there are less than two operands on the stack when tk is an operator, the stack is emptied and the evaluation is abandoned.

Outside of the evaluation loop, if there is exactly one number on the stack, the evaluation is considered successful and the result is printed. Otherwise, it is the error message that is output.

while {![eof stdin]} {
  set tks [split [string trim [gets stdin]]]
  if {0==[llength $tks]} {continue}
  set st [list]
  foreach tk $tks {
    if {$tk==""} {continue}
    if {[string is double $tk]} {
      lappend st [expr $tk+0.]
    } elseif {[string match {[-+*/]} $tk] && [llength $st]>=2} {
      set st [lreplace $st end-1 end  \
              [eval expr [lindex $st end-1] $tk [lindex $st end]]]
    } else {
      set st [list]
  puts [expr 1==[llength $st] ? {$st} : {"error"}]