Version 12 of procstep

Updated 2015-11-14 13:11:55 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.

Description

procstep provides one hook to inspect and manipulate the command before it is evaluated, and another to react to return codes. It requires scriptSplit and nocomments. These commands are also available as ycl proc tcl step.

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

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:

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

Here are some example handlers that don't do much of anything:

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

::tcl::proc errorhandler {namespace code cres copts}  {
    if {$code == 2} {
        tailcall return -code $code $cres
    }
    ::puts stderr [list {got an error} $code xxx $cres yyy $copts]
    tailcall return -code $code $cres
}