procc takes three arguments, a procedure name, an argument list given like (arg1, arg2, arg3) and a script written in c-like code. It transforms the script by some simple regexp rules with the following idea: basically any expression
x = expression;
is replaced by
set x [expr { EXPRESSION }]where EXPRESSION is tclified, by sticking a $ sign in front of each variable but leaving math functions unchanged. Other rules deal with transformations of "for" and "if" statements and a few others.
The new script is then concatenated with proc and a minor transformation of the argument list to remove the commas and replace the ()'s by {}, and then evaled to define a new procedure.
procc test3 (x,y) {
s1 = sin(x+y);
s2 = sin(x)*cos(y)+cos(x)*sin(y);
return s1-s2;
}
=> proc test3 {x y} {
set s1 [expr { sin($x+$y)}]
set s2 [expr { sin($x)*cos($y)+cos($x)*sin($y)}]
return [expr {$s1-$s2}]
}The algorithm for tclifying an expression looks for things that begin with a letter followed by alphanumerics, and adds a $ sign. If it's a math expression, then remove the $ sign. Things that caused me trouble can be seen in trying the following
e1=e2+2.*e3-1e6-exp(7.e2)-e89e2;
and I had to add extra stuff to deal with scientific notation.
It was originally written as an exercise in regexp and regsub and is basically limited by what regular expressions can do. Ultimately I'd like to see it capable of doing a well defined subset of c-like code, suitable for numerics.
To do:
Incorporate user defined math functions, i.e. replace
myFn(x, y) with [myFn x y], where x and y can generally be expressions.
This is straightforward if the arguments are simple, but what if you have nested calls? One limitation of regexps is finding matched parens. Doing this properly will probably require a full tokenizer.
WARNING: Thoroughly untested on all but the simplest expressions. However I'd appreciate any improvements, or just let me know where it falls over.
# Enable writing of 'c-style' code, primarily for convenience in writing
# numerical stuff.
# So I write "x=5*y+12.-sin(z)" instead of "set x [expr {5*$y+12.- sin($z)}]"
#
set mathFns [list abs cosh log sqrt acos double log10 srand \
asin exp pow tan atan floor rand tanh atan2 fmod round \
ceil hypot sin cos int sinh ]
set mathRegexp [join $mathFns "|"]
set varRegexp {[a-zA-Z_][a-zA-Z0-9_]}
# Some regexps
# assignmentRe - " x= 3*cos(theta)-5.;"
set assRe {^(\s*)([[:alpha:]]\w*) *=([^;]*);?$}
# reassRe - reassignment " x += 53*atan2(3.2,8.)-144/y;"
set reassRe {^(\s*)([[:alpha:]]\w*) *([-+*/])=([^;]*);?$}
# (hey this stuff looks just like TECO...)
# forRe - for statement " for (i=0; i<20; i++)"
set forRe {^(\s*)for\s*\(([^;]*);([^;]*);(.*)\)\s*\{$}
# ifRe - if statement " if ((x<10) || z>tan(theta))"
set ifRe {^(\s*)if\s*\((.*)\)\s*\{$}
# slifRe - single line if " if (x>2 && t<sin(2*z)) y+=3;
set slifRe {^(\s*)if\s*\((.*)\)(.*);$}
# returnRe - " return 2*x-1;
set returnRe {^(\s*)return\s*(.*);$}
# tclify --
# turn a math expression from c-style into Tcl.
# simplest version, only deals with variables, and math functions.
# (ie stuff that can be done with regsub.)
proc tclify {expression} {
global mathRegexp
set re {([[:alpha:]]\w*)}
if [string is double $expression] {return $expression}
# start by sticking a $ sign in front of all alpha expressions....
regsub -all $re $expression {$\1} expression
# but if its a math function remove it...
set re "\\\$($mathRegexp\[^A-Za-z0-9_\])"
regsub -all $re $expression {\1} expression
# the pathological case of the 'e' in a floating point number
set re {(\W[0-9]+\.?[0-9]*)\$e}
regsub -all $re $expression {\1e} expression
return $expression
}
# exprify --
# Wrap an expression EXPR in [expr {EXPR}] after tclifying EXPR
# if EXPR is a plain number leave alone, if a single variable, evaluate
proc exprify {expr} {
if {[string is double $expr]} {return $expr}
if {[regexp {^[[:alpha:]]\w*$} [string trim $expr]]} {
return "$[string trim $expr]"
}
return "\[expr \{[tclify $expr]\}\]"
}
proc lineType {line} {
if {[string trim $line]=="\{"} {return OPAREN}
if {[string trim $line]=="\}"} {return CPAREN}
if {[regexp {^\s*for[ \(]} $line]} {return FOR}
if {[regexp {^\s*return } $line]} {return RET}
if {[regexp {^\s*if[ \(].*;$} $line]} {return SLIF}
if {[regexp {^\s*if[ \(].*\{$} $line]} {return BLIF}
if {[regexp {^\s*[a-zA-Z_]\w* *=} $line]} {return ASSGT}
if {[regexp {^\s*[a-zA-Z_]\w* *[-+*/]=} $line]} {return REASSGT}
if {[regexp {^\s*\}\s*else\s*\{} $line]} {return ELSE}
return UNKNOWN
}
proc processLine {line} {
set ltype [lineType $line]
switch $ltype {
ELSE -
OPAREN -
CPAREN -
UNKNOWN {return $line}
default {return [do$ltype $line]}
}
}
proc doASSGT {line} {
regexp $::assRe $line v v0 v1 v2
return "${v0}set $v1 [exprify $v2]"
}
proc doREASSGT {line} {
regexp $::reassRe $line v v0 v1 v2 v3
return "${v0}set $v1 \[expr \{\$$v1$v2\([tclify $v3]\)\}\]"
}
proc doFOR {line} {
if [regexp $::forRe $line v v0 v1 v2 v3] {
set v1 [doASSGT $v1]
set v2 [tclify $v2]
if [regexp {(.*)\+\+} [string trim $v3] w w0] {
set v3 "incr $w0"
} else {
set v3 [exprify $v3]
}
return "${v0}for \{$v1\} \{$v2\} \{$v3\} \{"
}
}
proc doBLIF {line} {
if [regexp $::ifRe $line v v0 v1] {
set v1 [tclify $v1]
return "${v0}if \{$v1\} \{"
}
return $line
}
proc doSLIF {line} {
if [regexp $::slifRe $line v v0 v1 v2] {
set v1 [tclify $v1]
set v2 [processLine $v2]
return "${v0}if \{$v1\} \{$v2\}"
}
}
proc doRET {line} {
regexp $::returnRe $line v v0 v1
return "${v0}return [exprify $v1]"
}
proc procc {name aarghs program} {
global theScript
regsub -all {,} $aarghs " " aarghs
regsub {\(} $aarghs \{ aarghs
regsub {\)} $aarghs \} aarghs
set theScript {}
set ::theProg [split [list $program] \n]
foreach x $::theProg {
set nl [processLine $x]
puts $nl
append theScript $nl\n
}
uplevel "proc $name $aarghs $theScript"
}
procc test1 (x1,x2) {
f=0.0;
x=0.0
for (i=0; i<10; i++) {
for (j=1; j<i; j++) {
z=2*i/x1-1128.02e-4;
z1=sin(z);
z2=z1*z1;
z3=17.2e-4;
z4=z3;
f=(cos(z2)-3.0)/x2;
}
if (x1<5) z=2;
if (x2>7.e4) x*=3;
if ((x>0.0) || f<3) {
f*=-2;
} else {
f+=pow(x2, 2.);
}
e5=1.;
e89e2=0;
e3=1e3;
e2 = 1.e-3+.1e4*1e4;
e1=e2+2.*e3-1e6-exp(7.)-e89e2;
e1= .1e-4-e5;
}
return f;
}
procc test2 (i) {
sum1 = 0;
sum2 = 0;
sum3 = 0;
for (j=0; j<=i; j++) {
sum1 += j;
sum2 += j*j;
sum3 += j*j*j;
}
return sum3-sum1*sum1;
}
foreach i {1 2 3 6 10} {puts [test2 $i]}
procc test3 (x,y) {
s1 = sin(x+y);
s2 = sin(x)*cos(y)+cos(x)*sin(y);
return s1-s2;
}
for {set i 0} {$i<10} {incr i} {
puts [test3 [expr 5*rand()] [expr 5*rand()]]
}Chang Li How do you deal with array in it?