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] itself not
# 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: The 0th element is used for communication between suspend and resume, the last element is the command that resume should start the resumption with, and all elements in between record the internal state of some intermediate command in the call stack.
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}}A procedure parsetcl::cidic which does these transformations automatically can be found at code is data is code. It will be used by several commands below.
But first cmdseq and gamma. The basic (3-liner) definitions of these can be found at code is data is code, but with support for suspend and resume, these commands come out as the slightly longer:
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 -level [expr {[dict get $opt -level]+1}] $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
}
set code 0
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 -level [expr {[dict get $opt -level]+1}] $res
} else {
lset res end $resL
lappend res [info level 0]
return -code $::TCL_SUSPEND $res
}
}Basically, in order for the basic control structures (if, while, proc, uplevel, etc.) to support being suspended, they'll have to be reimplemented. Tcl is flexible enough to allow this, but in order to keep one's sanity (when distinguishing original and suspendable commands) it is much easier to give them distinct names (distinct even when removing namespace qualifiers). Therefore the reimplemented commands, which live in the suspendable namespace, will as a rule be titlecased (begin with an upper case letter).
First, there's problem of creating suspendable procedures (needed to demonstrate stackfullness). This needs two commands. First there is proccontext, which is put around the normal procedure body and whose job is to record the local context — currently just the local variable values — upon suspend and restore it upon resume.
proc suspendable::proccontext {cmd} {
variable resumeIndex
if {$resumeIndex>=0} then {
variable resumeData
foreach {scalarD arrayD} [lindex $resumeData $resumeIndex] break
incr resumeIndex -1
foreach {var value} $scalarD {
uplevel 1 [list ::set $var $value]
}
foreach {var value} $arrayD {
uplevel 1 [list ::array set $var $value]
}
}
set code [catch {uplevel 1 $cmd} res opt]
if {$code != $::TCL_SUSPEND} then {
return -options $opt -level [expr {[dict get $opt -level]+1}] $res
}
set scalarD {}
set arrayD {}
foreach var [uplevel 1 {::info locals}] {
if {[uplevel 1 [list ::array exists $var]]} then {
lappend arrayD $var [uplevel 1 [list ::array get $var]]
} else {
lappend scalarD $var [uplevel 1 [list ::set $var]]
}
}
lset res end [list $scalarD $arrayD]
lappend res [info level -1]
return -code $::TCL_SUSPEND $res
}Then there is Proc, which is a proc-lookalike. It transforms the body and wraps it up in a proccontext:
proc suspendable::Proc {name arglist body} {
uplevel 1 [list ::proc $name $arglist [
list [namespace which proccontext] [
::parsetcl::cidic $body
]
]]
}This was the final piece for test4, below.
The trickiest thing about while here is, perhaps unexpectedly, that its condition is an expression. In order to allow suspending from within an expression it would be necessary to parse and transform that just like parsetcl::cidic does with scripts, but I don't have a suitable expression parser at hand (and besides, the syntax of expressions is significantly more complicated than that of the endekalogue), so instead I've decided to make the condition of While a script just like the body. This means
While $condition $body
is like
while {[eval $condition]} $body(An alternative would be to keep the condition an expression and not support suspending in it, which for all examples below would work just as well, but still strikes me as less convincing.)
Another complication is that parsetcl::cidic isn't smart enough to transform the body and condition of a While command to cmdseq–gamma form, so the While command must do this for itself, at runtime. This isn't as onerous at it may seem however, since we can cache the transformed scripts between runs.
proc suspendable::While {condition body} {
variable Cache
if {![info exists Cache($condition)]} then {
set Cache($condition) [parsetcl::cidic $condition]
}
if {![info exists Cache($body)]} then {
set Cache($body) [parsetcl::cidic $body]
}
variable resumeIndex
if {$resumeIndex<0} then {
set state 1
} else {
variable resumeData
set state [lindex $resumeData $resumeIndex]
incr resumeIndex -1
}
# State 0: Loop terminated
# State 1: About to evaluate condition
# State 2: About to evaluate body
while {$state} {
if {$state==1} then {
# Condition case
set code [catch [list uplevel 1 $Cache($condition)] res opt]
if {$code} then {
break
} else {
set state [expr {$res ? 2 : 0}]
}
} else {
# Body case
set code [catch [list uplevel 1 $Cache($body)] res opt]
if {$code == 0} then {
set state 1
} elseif {$code == $::TCL_SUSPEND} then {
break
} elseif {$code == 3} then {
set state 0
set code 0
} elseif {$code == 4} then {
set state 1
} else {
set state 0
}
}
}
if {$code == 0} then {
return
} elseif {$code == $::TCL_SUSPEND} then {
lset res end $state
lappend res [info level 0]
return -code $::TCL_SUSPEND $res
} else {
return -options $opt -level [expr {[dict get $opt -level]+1}] $res
}
}This suffices for running also test5.
First some auxiliary commands for the test:
namespace eval test {namespace path {::suspendable ::tcl::mathop}}
foreach letter {A B C D E F} {
proc $letter {} "[list puts "I am $letter."]; [list return $letter]"
}The first test is a simple cmdseq, which is suspended and resumed twice:
proc test::test1 {} {
list [
catch {cmdseq A {suspend 1} B {suspend 2} C} cont ] $cont [
D ] [
catch {resume $cont 3} cont ] $cont [
E ] [
catch {resume $cont 4} cont ] $cont [
F ]
}Calling join [test::test1] \n returns
-1754758493
1 1 {cmdseq A {suspend 1} B {suspend 2} C}
D
-1754758493
2 3 {cmdseq A {suspend 1} B {suspend 2} C}
E
0
C
Fand it prints
I am A. I am D. I am B. I am E. I am C. I am F.
The second test is similar, but uses gamma instead of cmdseq, so that we may see that the suspends return what is given in the resumes.
proc test::test2 {} {
list [
catch {gamma list A {suspend 1} B {suspend 2} C} cont ] [
D ] [
catch {resume $cont 3} cont ] [
E ] [
resume $cont 4]
}Calling join [test::test2] \n this prints
I am A. I am D. I am B. I am E. I am C.
and returns
-1754758493 D -1754758493 E A 3 B 4 C
The third test demonstrates passing data from suspend to resume, processing it there, and passing it back. It also mixes cmdseq and gamma:
proc test::test3 {} {
gamma list {
catch {
cmdseq A {gamma puts {suspend 1}} {gamma list B {suspend 2} C}
} cont
} {set cont} D {
catch {
resume $cont [expr {-3*[lindex $cont 0 0]}]
} cont
} {set cont} E {
resume $cont [expr {5*[lindex $cont 0 0]}]
}
}In more traditional syntax, that catch is for the script
A puts [suspend 1] list [B] [suspend 2] [C]
It prints
I am A. I am D. -3 I am B. I am E. I am C.
and join [test::test3] \n returns
-1754758493
1 {} 1 {cmdseq A {gamma puts {suspend 1}} {gamma list B {suspend 2} C}}
D
-1754758493
2 B 2 {cmdseq A {gamma puts {suspend 1}} {gamma list B {suspend 2} C}}
E
B 10 CThis test demonstrates procedure nesting and preservation of local variables.
proc whereami {label} {
puts "I am $label."
puts " \[info level\] == [info level]"
for {set level 0} {$level+[info level]>0} {incr level -1} {
puts [format { level %1d: %s} $level [info level $level]]
}
return $label
}
namespace eval test {
Proc nest1 {x} {
whereami A
append x c
append x [suspend 7]
append x [whereami B]
}
Proc nest2 {x} {nest1 b$x}
Proc nest3 {continuation} {
set x [whereami C]
append x [
resume $continuation [expr {3*[lindex $continuation 0 0]}]
]
whereami D
return $x
}
Proc test4 {} {
whereami E
if {[catch {nest2 a} res] != $::TCL_SUSPEND} then {return $res}
nest3 $res
}
}The real body of test::nest1 becomes
::suspendable::proccontext {cmdseq {whereami A} {append x c} {gamma {append x} {suspend 7}} {gamma {append x} {whereami B}}}test::test4 prints
I am E.
[info level] == 2
level 0: whereami E
level -1: test::test4
I am A.
[info level] == 4
level 0: whereami A
level -1: nest1 ba
level -2: nest2 a
level -3: test::test4
I am C.
[info level] == 3
level 0: whereami C
level -1: nest3 {7 {} 2 {{x bac} {}} ba {{x a} {}} {nest2 a}}
level -2: test::test4
I am B.
[info level] == 5
level 0: whereami B
level -1: nest1 ba
level -2: nest2 a
level -3: nest3 {7 {} 2 {{x bac} {}} ba {{x a} {}} {nest2 a}}
level -4: test::test4
I am D.
[info level] == 3
level 0: whereami D
level -1: nest3 {7 {} 2 {{x bac} {}} ba {{x a} {}} {nest2 a}}
level -2: test::test4and returns
Cbac21B
This demonstrates suspending a While loop, passing data back and forth, and also running While without suspending it — typical coroutine stuff (but without creating temporary commands).
namespace eval test {
Proc test5a {limit} {
set res ""
set n 0
While {< $n $limit} {
lappend res $n [suspend $n]
incr n
}
set res
}
Proc test5 {limit} {
set code [catch {test5a $limit} res]
set acc ""
While {== $code $::TCL_SUSPEND} {
append acc [lindex $res 0 0]
set code [catch {resume $res $acc} res]
}
return $res
}
}For example:
% test::test5 6 0 0 1 01 2 012 3 0123 4 01234 5 012345
The N in NP (complexity class) stands for nondeterministic, which is perhaps hard to understand if you're used to associating nondeterminism with randomness, but in this case the concept is more like having a time machine in the CPU — usually this magical device is called an oracle. The idea is that whenever you have a choice to make, but cannot foresee the consequences of this choice, then you ask the oracle what you should choose. The oracle then tells you a choice that will lead to the wanted outcome (e.g. finding a solution to some problem), provided that such a choice exists; what happens if there isn't such a choice is less clear, but the computation should end with a FAIL condition (error). One science fiction approach to realising an oracle would be to use a time machine capable to creating alternate timelines when jumping back in time: Whenever you discover that you've made an incorrect choice, you just jump back to the last point where you had a choice and eliminate the alternative that didn't work, thus forcing the oracle to choose something else. Eventually you will find yourself on a timeline where all choices made are "magically" correct at the first attempt, so any NP-hard problem can be solved in polynomial time (but an exponential amount of time may well have been spent in alternative timelines when searching for the good one).
Normal computers don't have time machines built in, so one generally has to settle for some sort of backtracking when solving this kind of problem, but suspend and resume make it possible to write your program as if you had an oracle, hiding the details of the backtrack within the nondeterministic control structure. The definition of this is simply:
proc suspendable::nondeterministic {args} {
set stack {}
# Stack is a list with structure (regexp-style notation):
# (continuation untried)*
# Each untried is nonempty.
set code [catch {uplevel 1 $args} res opt]
while {$code == $::TCL_SUSPEND} {
switch -- [lindex $res 0 0] "choose" {
set choices [lindex $res 0 1]
if {[llength $choices]>1} then {
lappend stack $res [lrange $choices 1 end]
} elseif {![llength $choices] && [llength $stack]} then {
set choices [lindex $stack end]
set res [lindex $stack end-1]
if {[llength $choices]>1} then {
lset stack end [lrange $choices 1 end]
} else {
set stack [lreplace $stack end-1 end]
}
}
if {[llength $choices]} then {
set code [catch {
uplevel 1 [list resume $res [lindex $choices 0]]
} res opt]
} else {
set code 1
set res "No solution is possible"
set opt {-code 1 -level 0}
}
} default {
error {ToDo: implement [resume] of nondeterministic.}
}
}
return -options $opt -level [expr {[dict get $opt -level]+1}] $res
}You call it as
There are other control structures for backtracking search, but this one allows you to write your code in a very naive way, and still have it work.
To demonstrate the use of this, here is an implementation of colouring (by way of list-colouring) a graph. The graph is encoded as a dict mapping vertices to lists of neighbours (i.e., it is the neighbour function N).
namespace eval test {
Proc listcolour_core {graph colourlists showchoices} {
array set available $colourlists
set res [dict create]
set step 1
While {array size available} {
# First find vertex with fewest available colours
# (no need to be stupid just because we're naive).
set min infinity
foreach {v cL} [array get available] {
if {[llength $cL]<$min} then {
set min [llength $cL]
set v0 $v
}
}
# Then choose one of the colours available there.
set c0 [suspend choose $available($v0)]
if {$showchoices} then {
puts "Step $step: Coloured \"$v0\" $c0."
}
dict set res $v0 $c0
unset available($v0)
# Finally remove chosen colour from all neighbours
# (that hadn't already been coloured).
foreach u [dict get $graph $v0] {
if {![info exists available($u)]} then {continue}
set i [lsearch -exact $available($u) $c0]
if {$i>=0} then {
set available($u) [lreplace $available($u) $i $i]
}
}
incr step
}
return $res
}
proc colour {graph colors {showchoices 0}} {
set colourlists [dict create]
foreach v [dict keys $graph] {
dict set colourlists $v $colors
}
nondeterministic listcolour_core $graph $colourlists $showchoices
}
proc listcolour {graph colourlists {showchoices 0}} {
nondeterministic listcolour_core $graph $colourlists $showchoices
}
}In order to test this, we need some sample graphs.
proc complete_bipartite {left right} {
if {[llength [lsort -unique [concat $left $right]]] <
[llength $left] + [llength $right]} then {
return -code error "Left and right partition are not disjunkt"
}
set N [dict create]
foreach v $left {dict set N $v $right}
foreach v $right {dict set N $v $left}
return $N
}
proc Petersen {} {
set N [dict create]
for {set v 0} {$v<5} {incr v} {
dict lappend N $v [expr {($v-1)%5}] [expr {($v+1)%5}] [expr {$v+5}]
dict lappend N [expr {$v+5}] [expr {($v-2)%5+5}] [expr {($v+2)%5+5}] $v
}
return $N
}
proc edgegraph {G} {
set N [dict create]
dict for {u L} $G {
set E {}
foreach v $L {
lappend E [lsort [list $u $v]]
}
foreach e $E {
foreach f $E {
if {$e ne $f} then {dict lappend N $e $f}
}
}
}
return $N
}So, to 3-colour the Petersen graph [L1 ], one can do
% test::colour [Petersen] {red green blue}
4 red 0 green 9 green 5 red 7 blue 8 green 3 blue 1 red 2 green 6 blueBut this graph is not 2-colourable:
% test::colour [Petersen] {red green}
No solution is possibleIn order to see the backtracking in action, supply the optional showchoices argument:
% test::colour [Petersen] {red green} 1
Step 1: Coloured "4" red.
Step 2: Coloured "0" green.
Step 3: Coloured "9" green.
Step 4: Coloured "5" red.
Step 1: Coloured "4" green.
Step 2: Coloured "0" red.
Step 3: Coloured "9" red.
Step 4: Coloured "5" green.
No solution is possibleThe backtracking happen where the step numbers go down, since this is where an old continuation was resumed with a different choice.
To see that the Petersen graph is 4-edge-colourable, but not 3-edge-colourable, one may try to colour the vertices of its edge graph (a.k.a. line graph).
% test::colour [edgegraph [Petersen]] {red green blue black}
{7 9} red {2 7} green {5 7} blue {1 2} red {2 3} blue {4 9} green {3 4} red {0 4} blue {0 1} green {0 5} red {5 8} green {3 8} black {6 8} red {6 9} blue {1 6} black
% test::colour [edgegraph [Petersen]] {red green blue}
Error: No solution is possibleWe can also use the above to demonstrate that the complete graph on 3+3 vertices is 2-colourable but not 2-list-colourable [L2 ]:
% test::colour [complete_bipartite {1 2 3} {4 5 6}] {red green} 1
Step 1: Coloured "4" red.
Step 2: Coloured "1" green.
Step 3: Coloured "5" red.
Step 4: Coloured "2" green.
Step 5: Coloured "6" red.
Step 6: Coloured "3" green.
4 red 1 green 5 red 2 green 6 red 3 green
% set CL {}; for {set v 1} {$v<=6} {incr v} {dict set CL $v [lindex {{red green} {red blue} {blue green}} [expr {$v%3}]]}; set CL
1 {red blue} 2 {blue green} 3 {red green} 4 {red blue} 5 {blue green} 6 {red green}(This is a dictionary listing for each vertex the colours that are allowed there.)
% test::listcolour [complete_bipartite {1 2 3} {4 5 6}] $CL 1
Step 1: Coloured "4" red.
Step 2: Coloured "1" blue.
Step 3: Coloured "5" green.
Step 1: Coloured "4" blue.
Step 2: Coloured "1" red.
Step 3: Coloured "6" green.
No solution is possibleHowever, if we change one colour at one vertex, then it works:
% set CL2 $CL; dict set CL2 2 {green red}
1 {red blue} 2 {green red} 3 {red green} 4 {red blue} 5 {blue green} 6 {red green}
% test::listcolour [complete_bipartite {1 2 3} {4 5 6}] $CL2 1
Step 1: Coloured "4" red.
Step 2: Coloured "1" blue.
Step 3: Coloured "5" green.
Step 1: Coloured "4" blue.
Step 2: Coloured "1" red.
Step 3: Coloured "6" green.
Step 4: Coloured "2" red.
Step 5: Coloured "3" red.
Step 6: Coloured "5" blue.
4 blue 1 red 6 green 2 red 3 red 5 blueNEM: See also non-deterministic search.
NEM The non-determistic choice operator example is quite compelling. From my own experiments, I believe that the natural form of such an operator cannot be expressed using coroutines as implemented in 8.6a2. To give a simpler concrete example, consider the following code:
proc test {} {
set x [choose 1 2 3]
set y [choose 10 9 8 7 6]
if {$x**2 != $y} { fail }
return [list $x $y]
}Intuitively, this proc should succeed with values x=3, y=9. In this form, the code cannot be implemented with coroutines, as they are only capable of emulating one-shot continuations, whereas here we need to resume the choice-points multiple times. It also resumes in the wrong place -- i.e., fail would return the next choice, when we actually want to teleport back to the appropriate choose statement. As I understand the graph colouring example above, this code should be expressible with suspend/resume.
The question that then arises is whether this is a deal-breaker for coroutines? I'm not sure, as such back-tracking searches can already be written as custom control constructs, which may even be clearer. Such custom control constructs also perhaps better encapsulate the search strategy (allowing for e.g. parallel searching using multiple threads):
proc test {} {
choose x {1 2 3} y {10 9 8 7 6} {
if {$x**2 != $y} { fail }
}
return [list $x $y]
}This is for instance what the list monad does (see monads):
proc test {} {
do List x <- {1 2 3} y <- {10 9 8 7 6} {
if {$x**2 == $y} { return [list $x $y] }
}
}Another argument against this example, is that it is a fairly clear case in which you would presumably have written the code this way to begin with. It is not like an event loop example, where the goal is to convert an existing piece of synchronous code into asychronous code without altering the main body.
However, it does illustrate a clear limit of the expressiveness of coroutines, and one which could benefit from further discussion. Moving from coroutines to some more expressive continuation framework is not a clear-cut decision, and factors of implementation efficiency, ease of use/readability, and cost/benefit trade-offs would need to be considered. Further decisions would then have to be made on the precise form of continuation (e.g. full continuations or delimited continuations, etc), and then on the interface (call/cc, suspend/resume, various other operators that have been proposed in the literature), and finally on the implementation strategy (stack unwinding vs. something like NRE vs. ...).