PYK 2015-11-08: procstep is a drop-in replacement for proc that evaluates one command of a procedure body at at time.
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.
First, a little preparation:
rename proc ::tcl::proc
Now for a new proc:
::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} {
return $command
}
::tcl::proc errorhandler {namespace code cres copts} {
if {$code == 2} {
tailcall return {*}$copts $cres
}
tailcall return {*}$copts -code $code $cres
}Here is a monitor that disallows lindex:
::tcl::proc cmdhandler {namespace command} {
if {[namespace eval $namespace [
list namespace which [lindex $command 0]]] eq {::lindex}} {
return {error "lindex not allowed"}
}
::puts stderr [::list {now executing} $command]
return $command
}This monitor doesn't catch commands in command substitutions, so it wouldn't catch something like list lindex .... ycl proc step, however, does.
ycl proc step is a more fully-featured variant of stepproc. It could be used as the engine for the Sugar macro system, with the difference that it sould behave in a more LISPY way, expanding each command macro at the beginning of the command, rather that all at once when the procedured is defined. This defeats one of the stated objects of Sugar, namely performance, but brings the advantage of being more dynamic, allowing macros to consider the current state of execution. In contrast, ycl proc step would not be useful as an engine to drive knit because in knit macro procedures are explicitly defined and called directly as commands.
A macro system build on ycl proc step would, like Sugar, want to provide an interface for integrating it with commands that evaluate some of their arguments as scripts.
Another potential application for ycl proc step would be a condition system like that of LISP that allowed restarts. This was actually the motivation for ycl proc step. An interesting feature of ycl proc step is that it would allow restarts even in command substitutions.
I think that a tailcall for Tcl versions prior to 8.6 could also be written usiing ycl proc step. to be robust, though, all commands that evaluate some of their arguments as scripts or expressions would have to be wrapped.
#! /bin/env tclsh
package require {ycl proc step}
namespace import [yclprefix]::proc::step::bluepill
namespace import [yclprefix]::proc::step::redpill
proc cmdhandler {ns args} {
# Take the redpill to step out of the matrix in order to manage it.
redpill
#puts [list executing $args]
if {[lindex $args 0] eq {p2}} {
set return [list intrusion {*}$args]
} else {
set return $args
}
# Re-enter the matrix
bluepill
return $return
}
proc intrusion args {
return -code error [list \
{I'm sorry, Dave; I'm afraid I can't let you do} "$args"
]
}
[yclprefix] proc step subsume cmdhandler cmdhandler
bluepill
# Within the the matrix, every script and expression is filtered through the
# handlers.
proc p1 {} {
p2 {}
}
proc p2 x {
return {restricted content}
}
p1