Posted to tcl by Poor Yorick at Thu Feb 10 11:06:53 GMT 2022view raw

  1. proc done {} {
  2. variable status
  3. puts {Zipped and sent!}
  4. set status 0
  5. }
  6. proc download {dir url} {
  7. puts [list downloading $url]
  8. waitforstuff
  9. set content [list content of $url]
  10. if {$url eq {two}} {
  11. error {not two!}
  12. }
  13. save_file $dir $url $content
  14. lindex $url
  15. }
  16. proc downloaderror {cres copts} {
  17. set msg [list {error downloading} $cres]
  18. if {[dict exists $copts task]} {
  19. lappend msg task [dict get $copts task]]
  20. }
  21. puts stderr $msg
  22. }
  23. proc downloads {dir urls err} {
  24. set length [llength $urls]
  25. set tasks [lmap url $urls {
  26. list download $dir $url
  27. }]
  28. parallel $tasks err $err
  29. return
  30. }
  31. proc downloadzipandmail {dir urls} {
  32. downloads $dir $urls downloaderror
  33. zip $dir
  34. mail
  35. done
  36. }
  37. proc du {} {
  38. waitforstuff
  39. return {disk size done}
  40. }
  41. proc errhandler {cres copts} {
  42. puts [list {got this error} $cres]
  43. if {[dict exists $copts task]} {
  44. puts [list {error task} [dict get $copts task]]
  45. }
  46. }
  47. proc mail {} {
  48. puts [list mailed stuff]
  49. }
  50. proc parallel {tasks args} {
  51. while {[llength $args]} {
  52. set args [lassign $args[set args {}] arg]
  53. switch $arg {
  54. err {
  55. set args [lassign $args[set args {}] err]
  56. puts [list bugga $err]
  57. }
  58. default {
  59. error [list {unknown argument} $arg]
  60. }
  61. }
  62. }
  63. set length [llength $tasks]
  64. foreach task $tasks {
  65. after 0 [
  66. list worker proxy $task [list [info coroutine]]]
  67. }
  68. while {[incr length -1] >= 0} {
  69. if {[catch {return {*}[
  70. yieldto lindex [list [info coroutine]]]
  71. } cres copts]} {
  72. if {[info exists err]} {
  73. {*}$err $cres $copts
  74. }
  75. return -options $copts $cres
  76. }
  77. }
  78. }
  79. proc proxy {task return} {
  80. catch $task cres copts
  81. dict set copts task $task
  82. {*}$return -options $copts $cres
  83. }
  84. proc save_file {dirvar url content} {
  85. namespace upvar [namespace current] $dirvar dir
  86. puts [list saving to dir $dirvar]
  87. dict set dir $url $content
  88. }
  89. proc zip dirvar {
  90. namespace upvar [namespace current] $dirvar dir
  91. waitforstuff
  92. foreach {key value} $dir {
  93. puts [list $key $value]
  94. }
  95. }
  96. proc waitforstuff {} {
  97. set elapsed [expr {entier(rand() * 2000)}]
  98. after $elapsed [list [info coroutine]]
  99. yield
  100. }
  101. proc worker args {
  102. coroutine [info cmdcount] {*}$args
  103. }
  104. proc main_coro {argv0 argv} {
  105. yield [list [info coroutine]]
  106. set dir mydir
  107. set urls {one two three}
  108. parallel [list [list downloadzipandmail $dir $urls] du] err errhandler
  109. }
  110. after 0 [coroutine main main_coro $argv0 $argv]
  111. vwait status

AltStyle によって変換されたページ (->オリジナル) /