CMcC 26Aug08
Debug is a package to produce debug narrative. It is useful because a deselected debugging narrative stream is implemented as a very efficient noop, so it encourages the user to create narratives as complex as necessary for understanding.
Usage
First declare a narrative stream thus:
Debug on FOO 100
Where FOO is the narrative stream's name, and 100 is the level of interest we have in it. By convention, higher numbers are more detailed.
Then, scatter narrative through your code thus:
Debug.FOO {this is an arbitrary expression containing $vars [and exprs]} 10If the level of interest of the narrative line is less than the currently assigned level of interest, the narrative is substed and the output sent to the stream's open file descriptor.
Because the narrative string is substed in the caller's scope, one can perform arbitrarily complex computations which narrate the state of the computation, but because it's only conditionally substed according to level of interest in each narrative stream, the user can feel free to pepper their code with Debug narrative at fairly low cost when the Debugging's not needed. In my opinion, this freedom makes for a more literate programming style, more readable code, and easier debugging.
# Debug - a debug narrative logger.
#
# Debugging areas of interest are represented by 'tokens' which have
# independantly settable levels of interest (an integer, higher is more detailed)
#
# Debug narrative is provided as a tcl script whose value is [subst]ed in the
# caller's scope if and only if the current level of interest matches or exceeds
# the Debug call's level of detail. This is useful, as one can place arbitrarily
# complex narrative in code without unnecessarily evaluating it.
#
# TODO: potentially different streams for different areas of interest.
# (currently only stderr is used. there is some complexity in efficient
# cross-threaded streams.)
package provide Debug 2.0
namespace eval Debug {
variable detail
variable level 0
variable fds
proc noop {args} {}
proc debug {tag message {level 1}} {
variable detail
if {$detail($tag) >= $level} {
variable fds
set fd $fds($tag)
set code [catch {
uplevel 1 [list ::subst -nobackslashes [list $message]]
} result eo]
if {$code} {
set x [info level -1]
puts -nonewline $fd @@[string map {\n \\n \r \\r} "(DebugError from $tag [if {[string length $x] < 1000} {set x} else {set x "[string range $x 0 200]...[string range $x end-200 end]"}] ($eo)):"]
} else {
if {[string length $result] > 4096} {
set result "[string range $result 0 2047]...(truncated) ... [string range $result end-2047 end]"
}
puts $fd "$tag @@[string map {\n \\n} $result]"
}
} else {
#puts stderr "$tag @@@ $detail($tag) >= $level"
}
}
# names - return names of debug tags
proc names {} {
variable detail
return [lsort [array names detail]]
}
proc 2array {} {
variable detail
set result {}
foreach n [lsort [array names detail]] {
if {[interp alias {} Debug.$n] ne "::Debug::noop"} {
lappend result $n $detail($n)
} else {
lappend result $n -$detail($n)
}
}
return $result
}
# level - set level and fd for tag
proc level {tag {level ""} {fd stderr}} {
variable detail
if {$level ne ""} {
set detail($tag) $level
}
if {![info exists detail($tag)]} {
set detail($tag) 1
}
variable fds
set fds($tag) $fd
return $detail($tag)
}
# turn on debugging for tag
proc on {tag {level ""} {fd stderr}} {
level $tag $level $fd
interp alias {} Debug.$tag {} ::Debug::debug $tag
}
# turn off debugging for tag
proc off {tag {level ""} {fd stderr}} {
level $tag $level $fd
interp alias {} Debug.$tag {} ::Debug::noop
}
namespace export -clear *
namespace ensemble create -subcommands {}
}Lars H, 2008-08-26: Some remarks…
CMcC Thanks Lars! I took the view that backslash interpretation is a bad thing for code (usually) destined for a log file. I don't understand what that string range in 4 does. Everything else is (I hope) fixed.
Lars H: The idea in 4 is to make list quote all newlines, by giving it an unbalanced string (the extra left brace at the end); this prevents wrapping the string up in a brace and thus forces backslashing all special characters instead, in particular newline which becomes \n, whereas any existing \n becomes \\n. The string range then removes the extra final \{ from the string rep of the list. The downside of this technique is that it also backslashes all spaces, which can be annoying in text but works fairly well for raw data.
An alternative I thought of later at night is string map {\n \u240A} $result — \u240A (␊)is "symbol for line feed". That is probably more practical.