source expression.tcl
# Here is a little namespace to try out the parser. # namespace eval evaluate {
proc add { args } { expr [join $args +] }
proc sub { args } { expr [join $args -] }
proc mul { args } { expr [join $args *] }
proc div { args } { expr [join $args /] }
proc assign { a b } { set ::$a $b }
proc addasn { a b } { set ::$a [expr [set ::$a] + $b] }
proc subasn { a b } { set ::$a [expr [set ::$a] - $b] }
proc mulasn { a b } { set ::$a [expr [set ::$a] * $b] }
proc divasn { a b } { set ::$a [expr [set ::$a] / $b] }
proc inc { a } { incr ::$a }
proc dec { a } { incr ::$a -1 }
proc incu { a } { incr ::$a }
proc decu { a } { incr ::$a -1 }
proc uadd { a } { return [expr +$a] }
proc usub { a } { return [expr -$a] }
proc dolar { a } { set ::$a }
proc call { args } { {*}$args }
proc indx { args } { set ::[lindex $args 0]([join [lrange $args 1 end] ,]) }
proc eval { op args } { return [$op {*}$args] }}
# Process the operator table to create the string map table that suffices # for the lexical analyzer. # set tokens expression::prep-tokens $expression::optable
# A little test proc. # proc ? { a b } {
# Parse the expresson in $a by calling the evaluator on each subexpression
#
set result [expression::parse $a $::tokens $expression::optable evaluate::eval]
if { $result ne $b } { puts "$a : $result != $b" }}
? xx xx ; # Simple string identity
? 4+5*7 39 ; # Some math ? 4+(5*7) 39 ? (4+5)*7 63
? +4 4 ; # Unary ops ? -4 -4
? 9+4+6 19
? add(1,2,3) 6 ; # Function call ? add(1+2,2+2*3,3) 14
set x 1 set y 2 ? { x += $y } 3 ; # NB: The "$" is recognized as the "deref" ? { x -= $y } 1 ; # operator and handled in the evaluator. ? { x *= $y } 2 ? { x /= $y } 1
set a 3 ? {4 + a++} 8
set d(4) 8 set a d ? {($a)4} 8
# Check some errors # #catch { ? {$x .} rr. } reply; #if { $reply ne {parse error at: x _@_ . : unexpected token : x _@_ .} } { puts "fail : \$x . : $reply" } #catch { ? 4+8) xx } reply; #if { $reply ne {parse error at: 8 _@_ ) : unexpected ")" : 8 ) } } { puts "fail : unexpected \")\" : 8 ) : $reply" }
namespace eval a {} set a::b(4) 5 #? { $a::b4 } 5