stack-based calculator

GPS - Fri Jul 12, 2002: I've been curious about how interpreters work, and in particular how they evaluate sequences and magically return a result. The other day I looked at a little mathematical expression evaluator [L1 ] and the concept finally made sense. I came up with the following Tcl prototype to teach me how it works and verify my thoughts. Using a method similar to this a person could probably write a Tcl-like interpreter.


  #!/bin/tclsh8.3
  #version 1 July 12, 2002 
  proc push {arPtr val} {
    upvar $arPtr ar
    set len $ar(length)
    incr len
    set ar($len) $val
    set ar(length) $len
  }
  
  proc pop {arPtr} {
    upvar $arPtr ar
    set len $ar(length)
  
    if {![info exists ar($len)]} {
      return -code error "no element to pop"
    }
    set res [set ar($len)]
    unset ar($len)
    incr len -1
    set ar(length) $len
    return $res
  }
  
  proc evaluate {str} {
    array set operandStack {length 0}
    array set operatorStack {length 0}
  
    set digit ""
    set paren 0
    set parenStr ""
    set count 1
    foreach char [split $str ""] {
      if {$paren} {
        
        if {$char == "("} {
          incr count
        } elseif {$char == ")"} {
          incr count -1
          if {$count == 0} {
            set res [evaluate $parenStr]
            set count 1
            set paren 0
            set parenStr ""
            puts "sub eval $res"
            push operandStack $res
          }
        } else {
          append parenStr $char
        }
        continue
      }
  
      if {$char == "("} {
        set paren 1
      } elseif {$char == "."} {
        append digit $char
      } elseif {[string is digit $char]} {
        append digit $char
      } elseif {[string is space $char]} {
        if {$digit != ""} {
          push operandStack $digit
          set digit ""
        }
      } elseif {$char == "+"} {
        push operatorStack $char
      } elseif {$char == "-"} {
        push operatorStack $char
      } elseif {$char == "*"} {
        push operatorStack $char
      } elseif {$char == "/"} {
        push operatorStack $char
      }
    }
    
    if {$digit != ""} {
      push operandStack $digit
    }
    
    parray operandStack
    parray operatorStack
    puts "----"
    while {$operandStack(length) > 1} {
    
      set num2 [pop operandStack]
      set num1 [pop operandStack]
      set op [pop operatorStack]
  
      switch -- $op {
        "+" {
          push operandStack [expr {$num1 + $num2}]
        }
  
        "-" {
          push operandStack [expr {$num1 - $num2}]
        }
  
        "*" {
          push operandStack [expr {$num1 * $num2}]
        }
  
        "/" {
          push operandStack [expr {$num1 / $num2}]
        }
      }
    }
    if {$operatorStack(length) > 0} {
      return -code error "invalid expression: $str"
    }
    puts "returning $operandStack(1)"
  
    return $operandStack(1)
  }
  
  proc main {} {
    puts [evaluate "100 + 200 + (20 / 4) + (20.0 / 300) + 5"]
  }
  main

For an example of C code which parses Tcl commands, and C code with parses like expr does, see "Scratch" in the CriTcl library - README [L2 ], download [L3 ]. It has similarities with the above, yet also some differences and tricks. -jcw