#! /bin/env tclsh

package require {ycl coro relay}
namespace import [yclprefix]::coro::relay
package require {ycl shelf shelf}
namespace import [yclprefix]::shelf::shelf

shelf spawn machine

namespace eval doc {}

variable doc::machine {
	description {
		A "machine" object provides a mechanism to connect to and communicate
		with a machine which , in this case , is another process in which a Tcl
		interpreter is listening on stdin for commands . 
	}
}
machine eval {
	package require {ycl chan interp interp}
	namespace import [yclprefix]::chan::interp::interp
	rename interp rinterp
	namespace import [yclprefix]::coro::relay

	proc init _ {
		namespace upvar $_ sending sending sendqueue sendqueue
		coroutine ${_}::send $_ send_coro
		set sending 0
		set sendqueue {}
		coroutine ${_}::send_interp $_ rinterp_coro
		return $_
	}

	proc connect _ {
		relay order 0 [coroutine ${_}::connection ::apply [list _ {
			namespace upvar $_ chan chan
			namespace upvar $_ interp interp
			relay accept deliver [info coroutine]
			if {![
				catch {
					set chan [::open |[
						::list [::info nameofexecutable] - 2>@stderr] r+]
				} cres copts
			]} {
				catch {
					set interp [[rinterp spawn ${_}::interp1_[info cmdcount]] init $chan]
				} cres copts
			}
			{*}$deliver $cres $copts 
		} [namespace current]] $_]
	}

	proc disconnect _ {
		namespace upvar $_ chan chan interp interp
		close [$_ $ chan]
		unset chan
		unset interp
	}

	proc rinterp_coro {_} {
		namespace upvar $_ sending sending sendqueue sendqueue
		set sending 1
		while 1 {
			while {[llength $sendqueue]} {
				set sendqueue [lassign $sendqueue[set sendqueue {}] script deliver]
				set result [[$_ $ interp] send $script]
				{*}$deliver $result
			}
			set sending 0
			yield
		}
	}

	proc send_coro _ {
		namespace upvar $_ sending sending sendqueue sendqueue
		while 1 {
			relay accept {deliver script}

			# {ycl chan interp interp send} expect to be in a coroutine it can
			# yield from
			lappend sendqueue $script $deliver
			if {!$sending} {
				$_ send_interp
			}
		}
	}

}
machine method connect
machine subcmd connection
machine method disconnect
machine subcmd send
machine method send_coro
machine subcmd send_interp
machine method rinterp_coro


#### Demo ####


variable doc::main {
	description {
		Spins up $count machines and communicates with them
	}
}
coroutine main apply [list {} {
	set count 5
	set connections {}
	for {set i 0} {$i < $count} {incr i} {
		set machine m$i
		lappend machines $machine 
		[machine spawn $machine] init
		lappend connections [m$i connect]
	}

	# Wait until all connections are complete
	foreach connection $connections  {
		relay receive orders $connection
	}

	set orders {}
	set i 0
	foreach machine $machines {
		relay order 0 $machine send [list set a $i]
		dict set orders [relay order 0 $machine send {expr {$a * 3}}] $machine 
		incr i
	}


	# To receive results in any order
	while {[llength [dict keys $orders]]} {
		# Receive all orders to raise any errors, even if the result is
		# discarded here.
		set result [relay receive]
		if {[relay last] in $orders} {
			dict set results [dict get $orders [relay last]] $result
		}
		dict unset orders [relay last]
	}
	puts [list results $results]

	# To receive results in a particular order
	set orders {}
	set i 0
	foreach machine $machines {
		dict set orders $i order [relay order 0 $machine send {expr {$a * 5}}]
		dict set orders $i machine $machine
		incr i
	}

	foreach key [dict keys $orders] {
		dict set results2 [dict get $orders $key machine] [
			relay receive orders [dict get $orders $key order]]
	}
	puts [list results2 $results2]


	foreach machine $machines {
		$machine disconnect
	}

	# This returns the error result, "disconnected"
	catch {m1 send {lindex hello}} res options

	# This is an error message
	puts [list message $res]
	exit [dict get $options -code]

} [namespace current]]

vwait forever
