PYK 2015-11-08:
procstep is a drop-in replacement for
proc that evaluates one command of a procedure body at at time.
Description edit
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.
Using ycl proc step edit
#! /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