''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, ie 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
parans. 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?