#!/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"]
}
mainFor an example of C code which parses Tcl commands, and C code with parses like expr does, see "Scratch" in the CriTcl library - README [2], download [3]. It has similarities with the above, yet also some differences and tricks. -jcw
