diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-03-03 16:04:06 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:49 +1000 |
commit | 6f841c80b5a540c7d3cbf8ea73937019eb88656e (patch) | |
tree | 7f6049f2f1cbad8040d0feeb08e5e21ad0ac75da /stdlib.tcl | |
parent | 8a21e1c0ea44a829f84e526a8302e6effbc4a9b1 (diff) | |
download | jimtcl-6f841c80b5a540c7d3cbf8ea73937019eb88656e.zip jimtcl-6f841c80b5a540c7d3cbf8ea73937019eb88656e.tar.gz jimtcl-6f841c80b5a540c7d3cbf8ea73937019eb88656e.tar.bz2 |
Implement 'info frame' and some related procs
info frame allows access to source file/line for earler call frames
Implement 'stacktrace' to give a live stacktrace
And 'stackdump' to convert a stack trace to readable form
Update 'errorInfo' to use 'stackdump'
Also fix tailcall to retain source info
And implement alias, lambda and curry with tailcall
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'stdlib.tcl')
-rw-r--r-- | stdlib.tcl | 41 |
1 files changed, 37 insertions, 4 deletions
@@ -4,15 +4,14 @@ proc alias {name args} { set prefix $args proc $name args prefix { - uplevel 1 $prefix $args + tailcall {*}$prefix {*}$args } } # Creates an anonymous procedure proc lambda {arglist args} { set name [ref {} function lambda.finalizer] - uplevel 1 [list proc $name $arglist {*}$args] - return $name + tailcall proc $name $arglist {*}$args } proc lambda.finalizer {name val} { @@ -23,7 +22,7 @@ proc lambda.finalizer {name val} { proc curry {args} { set prefix $args lambda args prefix { - uplevel 1 $prefix $args + tailcall {*}$prefix {*}$args } } @@ -38,3 +37,37 @@ proc curry {args} { proc function {value} { return $value } + +# Returns a list of proc filename line ... +# with 3 entries for each stack frame (proc), +# (deepest level first) +proc stacktrace {} { + set trace {} + foreach level [range 1 [info level]] { + lassign [info frame -$level] p f l + lappend trace $p $f $l + } + return $trace +} + +# Returns a human-readable version of a stack trace +proc stackdump {stacktrace} { + set result {} + set count 0 + foreach {l f p} [lreverse $stacktrace] { + if {$count} { + append result \n + } + incr count + if {$p ne ""} { + append result "in procedure '$p' " + if {$f ne ""} { + append result "called " + } + } + if {$f ne ""} { + append result "at file \"$f\", line $l" + } + } + return $result +} |