[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 [closure]s, [coroutine]s, and [vwait]s 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], 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}} 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 } } ====== Next, there's problem of creating suspendable procedures. 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. (I considered naming it '''proc''' first, but not using the exact same names as the core commands relieves one of having to fully qualify all the standard names.) 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. Next: A suspendable loop. **Examples** 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]" } ====== ***test1*** 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 F ====== and it prints ====== I am A. I am D. I am B. I am E. I am C. I am F. ====== ***test2*** The second test is similar, but uses '''gamma''' instead of '''cmdseq''', so that we may see that the '''suspend'''s return what is given in the '''resume'''s. ====== 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 ====== ***test3*** 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 C ====== ***test4*** This 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::test4 ====== and returns ====== Cbac21B ====== ---- !!!!!! %| [Category Control Structure] | [Category Tcl Implementations] |% !!!!!!