Version 7 of procstep

Updated 2015-11-09 13:42:41 by pooryorick

PYK 2015-11-08: procstep is a drop-in replacement for proc that evaluates one command of a procedure body at at time, and a hook to inspect and manipulate the command before it is evaluated, and another to react to return conditions of the evaluation. It requires scriptSplit.

rename proc ::tcl::proc

::tcl::proc proc {name args body} {
    ::uplevel [::list ::tcl::proc $name $args [::list apply [::list args [
        ::string map [::list {${body}} [::list $body]] {
            ::foreach command [::scriptSplit ${body}] {
                ::if {[::catch [::list ::uplevel 1 [
                    ::cmdhandler $command]] cres copts]} {
                    ::tailcall ::errorhandler $cres $copts
                }
            }
        }
    ]] [uplevel {namespace current}]]]
}

::tcl::proc cmdhandler command {
   ::puts stderr [::list {now executing} $command]
   return $command
}

::tcl::proc errorhandler {cres copts}  {
   ::puts stderr [list {got an error} $cres]
   #puts [uplevel info locals]
}

Here is a variant that improves runtime performance quite a bit by rewriting each command of the body when the procedure is created. This leaves no private space for catch to create its output variables in, so it stuffs them into $::tcl::cres and ::tcl::copts instead instead:

rename proc ::tcl::proc
::tcl::proc proc {name args body} {
    set newbody {}
    ::foreach command [::scriptSplit $body] {
        ::append newbody [::string map [::list {${command}} [
            ::list $command]] {
                ::if {[::catch {if 1 [
                    ::cmdhandler ${command} [
                        namespace current]]} ::tcl::cres ::tcl::copts]} {
                    ::errorhandler $::tcl::cres $::tcl::copts
                }
        }]
    }
    ::uplevel [::list ::tcl::proc $name $args $newbody]
}

::tcl::proc cmdhandler {command namespace} {
   ::puts stderr [::list {now executing} $command]
   return $command
}

::tcl::proc errorhandler {cres copts}  {
   ::puts stderr [list {got an error} $cres]
   #puts [uplevel info locals]
}