Arjen Markus (7 may 2004) Recent interest in the possibilities of using Tcl for numerical analysis, brought back the page A little math language. I decided to explore this a bit further ... It is not complete yet, but you get the drift, I think, from the examples/test code.
# math.tcl --
# Provide commands that allow a more usual mathematical syntax:
#
# mathfunc {x} {
# sinc = sin(x)/x if x != 0
# sinc = 0 otherwise
# }
# math {
# a = x*x + y*y
# }
#
# Still to do: mathfunc
#
namespace eval ::mathsyntax {
namespace export math
variable cached_calcs {}
}
# ToExpr --
# Transform an expression to the form expr wants
# Arguments:
# expression A right-hand side of an assignment
# Result:
# Valid Tcl expression
#
proc ::mathsyntax::ToExpr { expression } {
set rhs [string map {" " ""} $expression]
set indices [regexp -inline -all -indices {[a-zA-Z][a-zA-Z0-9_]*} $rhs]
set offset 0
foreach idx $indices {
foreach {start stop} $idx {break}
set start [expr {$start+$offset}]
set stop [expr {$stop+$offset}]
set next [expr {$stop+1}]
if { [string index $rhs $next] != "(" } {
set char [string index $rhs $start]
set rhs [string replace $rhs $start $start "\$$char" ]
incr offset
}
}
return $rhs
}
# Transform --
# Transform a series of mathematical expressions into Tcl code
# Arguments:
# id ID to use
# calc One or more mathematical assignments
# Result:
# None
# Side effects:
# A private procedure is created
# Note:
# No conditions yet
#
proc ::mathsyntax::Transform { id calc } {
set calc [split $calc "\n"]
set body {"uplevel 2 \{"}
foreach assign $calc {
set assign [string trim $assign]
if { $assign != "" } {
regexp {([a-zA-Z][a-zA-Z0-9_]*) *= *(.*)} $assign ==> lhs rhsfull
#
# Is there a condition?
#
set cond1 [string first " if" $rhsfull]
# PM: set cond2 [string first " otherwise" $rhsfull]
set cond ""
if { $cond1 > 0 } {
set rhs [string range $rhsfull 0 [expr {$cond1-1}]]
set cond [string range $rhsfull [expr {$cond1+3}] end]
lappend body "if { [ToExpr $cond] } \{"
} else {
set rhs $rhsfull
}
# if { $cond2 > 0 } {
# set rhs [string range $rhsfull 0 [expr {$cond2-1}]
#
# set cond [string range $rhsfull [expr {$cond1+3} end]
# }
#
# Prepare the assignment
#
set rhs [ToExpr $rhs]
lappend body "set $lhs \[expr {$rhs}\]"
if { $cond != "" } {
lappend body "\}"
}
}
}
lappend body "\}"
proc Cached$id {} [join $body "\n"]
}
# math --
# Allow mathematical expressions inside Tcl code
# Arguments:
# calc One or more mathematical assignments
# Result:
# None
# Side effects:
# As the code is executed in the caller's scope, variables
# in the calling procedure are set
# The code is transformed into a procedure that is cached
#
proc ::mathsyntax::math { calc } {
variable cached_calcs
set id [lsearch $cached_calcs $calc]
if { $id < 0 } {
lappend cached_calcs $calc
set id [expr {[llength $cached_calcs]-1}]
Transform $id $calc
}
::mathsyntax::Cached$id
}
#
# Simple test
#
namespace import ::mathsyntax::math
set a 1
set b 1
set c ""
set d ""
set sinc ""
math {
c = a + b
d = a + cos(b+c)
}
puts "$c $d"
for {set i 0} {$i < 20} {incr i} {
math {
x = 0.1*i
sinc = 1 if x == 0
sinc = sin(x)/x if x != 0
}
puts "$i $x $sinc"
}