The primary purpose of this problem was to expose the new [[trace execution]] command that was added in Tcl 8.4. [Andrej Vckovski] took the laurels on this problem, with the following solution, which even favored us with a test harness to demonstrate its execution: # display a call graph of the passed command line # AVckovski, 2002-11-20 proc callGraph {cmdLine} { proc ::_myEnterstep {cmdString ops} { set cmdName [lindex $cmdString 0] if {[string length [info proc $cmdName]]} { if {![info exists ::_traces($cmdName)]} { trace add execution $cmdName enterstep ::_myEnterstep # lazy cleanup; just remember all traces instead of using trace info set ::_traces($cmdName) ::_myEnterstep } } # display command word, indented # if more than one line, just 1st, and limit line length set cmdString [lindex [split $cmdString \n] 0] if {[string length $cmdString]>40} { set cmdString "[string range $cmdString 0 40] ..." } puts "[string repeat -- [info level]] $cmdString" } # init some state #set ::_traces {} # setup and start set cmdName [lindex $cmdLine 0] uplevel [list ::_myEnterstep $cmdLine enterfirst] uplevel $cmdLine # cleanup our recorded traces foreach cmdName [array names ::_traces] { trace remove execution $cmdName enterstep $::_traces($cmdName) } # cleanup state rename ::_myEnterstep "" unset ::_traces } # test case proc sum {a b} { return [expr $a + $b] } proc z {} {return [sum [sum [sum [sum 5 6] 7] 8] [sum 11 22]]} proc fac {n} { if {$n==1} { return 1 } else { return [expr $n*[fac [expr $n-1]]] } } callGraph z callGraph {fac 8} ---- which produces output that looks like: -- z ---- sum 5 6 ------ expr 5 + 6 ------ expr 5 + 6 ------ return 11 ------ return 11 ---- sum 11 7 ------ expr 11 + 7 ------ expr 11 + 7 ------ return 18 ------ return 18 ---- sum 18 8 ------ expr 18 + 8 ------ expr 18 + 8 ------ return 26 ------ return 26 . . . ---- In preparation for the contest, [KBK] had developed the following solution: proc K { x y } { return $x } proc doit { command } { uplevel 1 $command } proc callgraph { command } { variable context variable children variable did set context {} trace add execution doit enterstep enter trace add execution doit leavestep leave uplevel 1 [list doit $command] trace remove execution doit enterstep enter trace remove execution doit leavestep leave display uplevel catch { unset children } catch { unset did } return } proc enter { commandStr op } { variable context variable children set command [lindex $commandStr 0] set children([lindex $context end],$command) {} lappend context $command return } proc leave { commandStr code result op } { variable context # There's a Tcl bug where we get extra 'leave' traces. Work around it. if { [info level] < [llength $context] } { set context [lreplace [K $context [set context {}]] [info level] end] } return } proc display { context { level 0 } } { variable children variable did set last [lindex $context end] if { [info exists did($last)] } { if { [llength [array names children $context,*]] > 0 } { puts [format %*s... [expr { 4 * $level}] {}] } } else { set did($last) {} foreach child [lsort [array names children $context,*]] { foreach { - childproc } [split $child ,] break puts [format %*s%s [expr { 4 * $level}] {} $childproc] display $childproc [expr { $level + 1 }] } } return } ---- which produces rather more compact output; on Andrej's test case, it shows % callgraph z z return sum expr return % callgraph {fac 8} fac expr fac ... if expr return ---- [Tcl2002 programming contest: problem 3] [The Great Canadian Tcl/Tk Programming Contest], eh? <> Community | Debugging | Performance | Example