Lars H, 2008-08-27: As the title says, this page is about giving a proof-of-concept implementation of suspend and resume commands. Amongst other things, the full primitives could be used to implement closures, coroutines, and vwaits that don't nest, but what is here is merely about demonstrating that the basic idea is sound. See suspend and resume for a description of the commands.
The first step is to select a unique code for TCL_SUSPEND. I chose to make one from the word suspend as follows:
set TCL_SUSPEND 0
foreach char [split suspend ""] {
set TCL_SUSPEND [expr {$TCL_SUSPEND*29+[scan $char %c]-97}]
}
unset char
set TCL_SUSPEND [expr {int($TCL_SUSPEND)}](This comes out as an integer near -1.75476e+09.)
The next step is to define the commands themselves, and the data structures they employ:
namespace eval suspendable {
variable resumeIndex -1
variable resumeData {}
# variable resumeStack {}
}
proc suspendable::suspend {args} {
variable resumeData
variable resumeIndex
if {$resumeIndex < 0} then {
return -code $::TCL_SUSPEND [list $args [info level 0]]
} elseif {$resumeIndex==0} then {
set resumeIndex -1
return {*}[lindex $resumeData 0]
} else {
error "This shouldn't happen."
}
}
proc suspendable::resume {continuation args} {
lset continuation 0 $args
variable resumeIndex
variable resumeData
# variable resumeStack
# if {$resumeIndex>=0} then {
# error "Unimplemented -- can't resume something while resuming"
# }
set resumeData $continuation
set resumeIndex [expr {[llength $resumeData]-2}]
uplevel 1 [lindex $resumeData end]
# That this call is *not* caught is what makes [resume] not itself
# show up in continuations if resuspended.
}The resumeStack variable is reserved for future enhancements, to make resume reentrant. That's a fairly unusual need, though.
The resumeData here is as described on suspend and resume, but with one exception: the final element is the command to call to start the resuming. Since a command that emits the return code TCL_SUSPEND can't know if it is the last one however, every command has to put its [info level 0] last in the result, and the next one in line has to replace it with its internal state before appending its own [info level 0].
What is tricky about this is that when resuming, we need to jump to specific commands within a sequence of commands, and to specific command substitutions within a larger command — that involves some rather tricky parsing if done with ordinary Tcl syntax. So instead it will be required that any script of the form
eval "$A\n$B\n$C\n…"
is written as
cmdseq $A $B $C …
and any script of the form
{*}$prefix [eval $A] [eval $B] [eval $C] …is written as
gamma $prefix $A $B $C …
Concretely, instead of
set L foo lappend L [pid] [info hostname]
one would (for now) have to write
cmdseq {set L foo} {gamma {lappend L} {pid} {info hostname}}With support for suspend and resume, these commands can then be implemented as:
proc suspendable::cmdseq {args} {
variable resumeIndex
if {$resumeIndex<0} then {
# Initial case
set count 0 ; # The internal state
} else {
# Resuming case
variable resumeData
set count [lindex $resumeData $resumeIndex]
incr resumeIndex -1
}
foreach cmd [lrange $args $count end] {
set code [catch {uplevel 1 $cmd} res opt]
if {$code!=0} then {break}
incr count
}
if {$code != $::TCL_SUSPEND} then {
return -options $opt $res
} else {
lset res end $count
lappend res [info level 0]
return -code $::TCL_SUSPEND $res
}
}
proc suspendable::gamma {prefix args} {
variable resumeIndex
if {$resumeIndex<0} then {
# Initial case
set resL {} ; # The internal state
} else {
# Resuming case
variable resumeData
set resL [lindex $resumeData $resumeIndex]
incr resumeIndex -1
}
foreach cmd [lrange $args [llength $resL] end] {
set code [catch {uplevel 1 $cmd} res opt]
if {$code!=0} then {break}
lappend resL $res
}
if {$code==0} then {
set code [catch {uplevel 1 $prefix $resL} res opt]
}
if {$code != $::TCL_SUSPEND} then {
return -options $opt $res
} else {
lset res end $resL
lappend res [info level 0]
return -code $::TCL_SUSPEND $res
}
}And that's pretty much it, for now. The natural next step would be a proc-analogue (defining suspendable commands), and after that one can start with the rest of the control sequences — defining suspendable if, while, for, etc. — to reimplement as much of Tcl as one wishes.
First some auxiliary commands for the test:
namespace eval test {namespace path ::suspendable}
foreach letter {A B C D E F} {
proc $letter {} "[list puts "I am $letter."]; [list return $letter]"
}