[Sarnold]: The following snippet defines a '''xbody''' command, which takes a code body as argument, and transforms it, putting directly math expressions inside expr calls. For example: xbody {puts $x+1} returns: {puts [expr {$x+1}]} How does it work? It just parse commands (with [cmdSplit]) and each word of each command is matched against some syntax rules: * if the word starts with a number or a $variable * if it is not a single number or variable * if it is not a concatenation of string variables Then, the word is put inside a expr call. The if, while and for bodies are recognized as nested bodies, and substitutions of expr calls occur inside them. (see TESTS at the bottom of this page) ---- ====== namespace eval xbody { namespace export xbody proc cmdSplit {body} { set commands {} set chunk "" foreach line [split $body "\n"] { append chunk $line if {[info complete "$chunk\n"]} { # $chunk ends in a complete Tcl command, and none of the # newlines within it end a complete Tcl command. If there # are multiple Tcl commands in $chunk, they must be # separated by semi-colons. set cmd "" foreach part [split $chunk ";"] { append cmd $part if {[info complete "$cmd\n"]} { set cmd [string trimleft $cmd] # Drop empty commands and comments if {![string match {} $cmd] \ && ![string match \#* $cmd]} { lappend commands $cmd } if {[string match \#* $cmd]} { set cmd "\#;" } else { set cmd "" } } else { # No complete command yet. # Replace semicolon and continue append cmd ";" } } set chunk "" } else { # No end of command yet. Put the newline back and continue append chunk "\n" } } if {![string match {} [string trimright $chunk]]} { return -code error "Can't parse body into a\ sequence of commands.\n\tIncomplete\ command:\n-----\n$chunk\n-----" } return $commands } proc wordSplit {command} { if {![info complete $command]} {error "non complete command"} set res ""; # the list of words set chunk "" foreach word [split $command " \t"] { # testing each word until the word being tested makes the # command up to it complete # example: # set "a b" # set -> complete, 1 word # set "a -> not complete # set "a b" -> complete, 2 words append chunk $word if {[info complete "$res $chunk"]} { lappend res $chunk set chunk "" } else { append chunk " " } } set res } proc getNumber {word} { if {[regexp {^[+\-]?[0-9]+\.?[0-9]*([eE][+\-]?[0-9]*)?} $word -> var]} {return $var} return "" } proc isVarExpr {word} {isPattern $word {^\$(\\{[a-zA-Z0-9_]+\\}|[a-zA-Z0-9_]+)}} proc isPattern {word pat} { if {![regexp $pat $word -> var]} {return false} regsub $pat $word "" word expr {$word ne "" && ![regexp $pat $word]} } proc isExpr {word} { set num [getNumber $word] set var [isVarExpr $word] expr {($num ne "" && $num ne $word) || $var} } proc xcontrol_if {cond body args} { lappend result if $cond [_body $body] while {[llength $args]>=3} { set args [lassign $args word cond body] lappend result $word $cond [_body $body] } if {[llength $args] != 2} {return $result} lassign $args word body lappend result $word [_body $body] } proc xcontrol_while {cond body} {list while $cond [_body $body]} proc xcontrol_for {initial cond step body} {list for [_body $initial] $cond [_body $step] [_body $body]} proc _body body { if {[string index $body 0] eq "\{"} {set body [string range $body 1 end-1]} return "{[xbody $body]}" } proc xbody {body} { set outBody "" foreach cmd [cmdSplit $body] { set outCmd "" set cmd [wordSplit $cmd] if {[lindex $cmd 0] in {if while for}} {set cmd [xcontrol_[lindex $cmd 0] {*}[lrange $cmd 1 end]]} foreach word $cmd { if {[isExpr $word]} { lappend outCmd "\[expr \{$word\}\]" } else { lappend outCmd $word } } append outBody [join $outCmd]\n } string trimright $outBody \n } } ====== ---- ====== # SOME TESTS proc t {body} {puts "$body\n-->[xbody::xbody $body]"} t {if {$x>0} {puts $x+1} else {puts $y-1}} t {if {$x>0} {puts $x+1} elseif {$h<3} {puts $y-1}} ====== <>Syntax