1# -*- tcl -*- 2# General tree iterative walking for dataflow algorithms. 3 4# ### ### ### ######### ######### ######### 5## Requisites 6 7package require snit 8 9# ### ### ### ######### ######### ######### 10## API 11 12namespace eval ::page::util::flow {} 13 14proc ::page::util::flow {start fvar nvar script} { 15 set f [uplevel 1 [list ::page::util::flow::iter %AUTO% $start $fvar $nvar $script]] 16 $f destroy 17 return 18} 19 20# ### ### ### ######### ######### ######### 21## Internals 22 23snit::type ::page::util::flow::iter { 24 constructor {startset fvar nvar script} { 25 $self visitl $startset 26 27 # Export the object for use by the flow script 28 upvar 3 $fvar flow ; set flow $self 29 upvar 3 $nvar current 30 31 while {[array size visit]} { 32 set nodes [array names visit] 33 array unset visit * 34 35 foreach n $nodes { 36 set current $n 37 set code [catch {uplevel 3 $script} result] 38 39 # decide what to do upon the return code: 40 # 41 # 0 - the body executed successfully 42 # 1 - the body raised an error 43 # 2 - the body invoked [return] 44 # 3 - the body invoked [break] 45 # 4 - the body invoked [continue] 46 # everything else - return and pass on the results 47 48 switch -exact -- $code { 49 0 {} 50 1 { 51 return -errorinfo $::errorInfo \ 52 -errorcode $::errorCode -code error $result 53 } 54 3 { 55 # FRINK: nocheck 56 return -code break 57 } 58 4 {} 59 default { 60 # This includes code 2 (return). 61 return -code $code $result 62 } 63 } 64 } 65 } 66 return 67 } 68 69 method visit {n} { 70 set visit($n) . 71 return 72 } 73 74 method visitl {nodelist} { 75 foreach n $nodelist {set visit($n) .} 76 return 77 } 78 79 method visita {args} { 80 foreach n $args {set visit($n) .} 81 return 82 } 83 84 variable visit -array {} 85} 86 87# ### ### ### ######### ######### ######### 88## Ready 89 90package provide page::util::flow 0.1 91