proc traceproc {variableName arrayElement operation} {
  set level [info level
  incr level -1;
  if {$level > 0} {
     set procid [info level $level]
     } else {set procid "root level"}
  if {![string match $arrayElement ""]} {
    puts "Performed operation $operation on $variableName($arrayElement) : $procid"
    } else {
    puts "Performed operation $operation on $variableName : $procid"
    }
  }

proc traceme {input1 input2} {
  set x $input1
  puts $input1
  set input 2;
  upvar $input2 i
  set i 2
  }

trace variable i1 w traceproc
puts "set trace 1"
trace variable i2 r traceproc
puts "calling traceme"
traceme i1 i2
puts "intact"
set i1 "OK"
trace vinfo i1 
trace vinfo i2