#! /bin/env tclsh
package require {ycl time timer}
namespace import [yclprefix]::time::timer
package require {ycl proc step}
namespace import [yclprefix]::proc::step::stepconfig
namespace import [yclprefix]::proc::step::stepscript
namespace import [yclprefix]::proc::step::stepproc
#stepproc steptime cmdhandler [list apply [list {ns args} {
# puts [list hey $args]
# puts [list yack [info errorstack]]
# tailcall if 1 $args
#} [namespace current]]]
timer timer1
timer1 start
variable steptime
proc steptime {name argspec body} {
set script {
set id [info cmdcount]
apply [list {script} {
foreach cmd $script {
uplevel 1 $cmd
}
} [namespace current]]
}
set config [stepconfig subs 0 varsubs 0 cmdhandler [list apply [list {infoname ns args} {
return $args
} [namespace current]]] \
cmdhandler_template [set [
yclprefix]::proc::step::cmdhandler_body_simple]
]
lassign [stepscript $body $config] infoname info body2
#puts [list hubba $info]
#exit 22
uplevel 1 [list ::proc $name $argspec $body2]
}
proc mark {} {
variable marks
set time1 [clock clicks]
set mark [list $time1 [expr {rand()}]]
dict set marks $mark {count 0 mean 0 min -1 max -1}
return $mark
}
proc markend mark {
variable marks
set time2 [clock clicks]
dict update marks $mark count count mean mean max max min min {
set elapsed [expr {$time2 - $time1}]
set mean [expr {(($mean * $count) + $elapsed) / double([
incr count])}]
if {$min < 0 || $elapsed < $min} {
set min $elapsed
}
if {$elapsed > $max} {
set max $elapsed
}
}
}
proc timed cmd {
set tmpname [namespace current]::[info cmdcount]
set ns [uplevel {namespace current}]
# This verifies that command currently exists .
uplevel [list ::rename $cmd $tmpname]
set tail [namespace tail $cmd]
set prefix [string range $cmd 0 [
expr {[string length $cmd] - [string length $tail] - 1}] ]
while 1 {
set newname $prefix${tail}_[info cmdcount]
if {[uplevel 1 [list namespace which $newname]] eq {}} {
break
}
}
uplevel 1 [list ::rename $tmpname $newname]
uplevel 1 [list ::proc $cmd args [string map [list \
@timings@ [list [namespace current]::timings] \
@newname@ [list $newname] \
@ns@ [list $ns] \
@cmd@ [list $cmd] \
@nscmd@ [list $ns $cmd]] {
upvar 0 @timings@ timings
set time1 [clock clicks]
catch {uplevel 1 [list apply [list pargs {tailcall @newname@ {*}$pargs} @ns@] $args]} cres copts
set time2 [clock clicks]
if {![dict exists $timings @nscmd@]} {
dict set timings @nscmd@ [dict create count 0 mean 0 min -1 max -1]
}
set t [dict get $timings @nscmd@]
dict update t count count mean mean max max min min {
set elapsed [expr {$time2 - $time1}]
set mean [expr {(($mean * $count) + $elapsed) / double([
incr count])}]
if {$min < 0 || $elapsed < $min} {
set min $elapsed
}
if {$elapsed > $max} {
set max $elapsed
}
}
dict set timings @nscmd@ $t
return -options $copts $cres
}]]
}
proc report {} {
variable marks
variable timings
return [dict create marks $marks timings $timings]
}
variable marks {}
variable timings {}