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

**Making scripts machine introspectable**

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


**Reimplementing Tcl core commands**

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

***proc***

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.

***while***

The trickiest thing about [while] here is, perhaps unexpectedly, that its condition is an [expr]ession. In order to allow '''suspend'''ing 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 [expr]essions 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 '''suspend'''ing 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.


**Examples**

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

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

***test5***
This demonstrates '''suspend'''ing 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

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