compute

# compute provides some preprocessing capabilities for expr.
 # It will add a "$" sign to anything in the expression that
 # is a variable in the uplevel context, if it doesn't already
 # have one.  It maps ' to " in the final translation, to insure
 # string comparisons are done in a string context, It maps
 # "and" to &&; "or" to ||; "not" to !; "<>" to !=; "true", "on"
 # and "yes" to 1 and "false", "off" and "no" to 0.  It also
 # maps "pi" to 3.1415926535

 # glennj:  no need to map {true on yes false off no} since those
 #          are already valid truth values.
 #
 # pse: huh? they are valid truth values? what does THAT mean??
 #      they sure aren't boolean values to Tcl.

 proc compute { args } {
 # puts "expr $args"
  set exp ""
  set id ""
  regsub "''" [ string trim $args ] "@@@" args
  while 1 {
    regexp "(\[^a-zA-Z_'\]*)(\[a-zA-Z0-9_'\]*)(.*)" $args -> head id tail
    if ![ string length $id ] {
      set exp "$exp$head"
      break
    }
    set dollar ""
    if ![ string equal [ string index $id 0 ] "'" ] {
      if ![ string equal [info commands $id] "" ] {
        set id "\[ $id"
        regexp {[^\(]*\(([^\)]*)\)(.*)} $tail -> params tail
        set tail " $params \]$tail"
      } elseif [ uplevel info exists $id ] { set dollar "\$" }
    }
    append exp "$head$dollar$id"
    set args $tail
  }
  regsub -all "'" $exp "\"" exp
  set map "@@@ ' and && or || not ! <> != true 1 false 0 on 1 off 0 yes 1 no 0 pi 3.1415926535"
  foreach { from to } $map {
    regsub $from $exp $to exp
  }
  # as of tcl 8.3, more efficient to replace foreach look with:
  #   set exp [string map $map $exp]
  set exp [ uplevel subst \{$exp\} ]
  return [ expr $exp ]
 }
Category Uncategorized