[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] 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.



**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]"
}
======

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.
======

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
======

The third (and so far final) 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
======


----
!!!!!!
%| [Category Control Structure] | [Category Tcl Implementations] |%
!!!!!!