Posted to tcl by aspect at Thu Nov 19 04:16:19 GMT 2015view pretty

proc fixpoint {varName script} {
    upvar 1 $varName arg
    while {[set res [uplevel 1 $script]] ne $arg} {
        set arg $res
    }
    return $res
}

proc dfs {cmdPrefix seed} {
    set stack [list $seed]
    set result {}
    while {[llength $stack]} {
        set stack [lassign $stack seed]
        lappend result $seed
        set stack [linsert $stack 0 {*}[uplevel 1 $cmdPrefix [list $seed]]]
    }
    return $result
}

# ^^ -- not used in this example, but relevant variations on [bfs] -- ^^

proc bfs {varName script} {
    upvar 1 $varName seed
    set queue [list $seed]
    set result {}
    while {[llength $queue]} {
        set queue [lassign $queue seed]
        lappend result $seed
        lappend queue {*}[uplevel 1 $script]
    }
}

set arclist {
    a b
    a p
    b m
    b c
    c d
    d e
    e f
    f q
    f g
}
foreach {from to} $arclist {
    dict lappend arcs $from $to
}

proc findpath {arcs from to} {
    set path [list $from]
    set good {}
    bfs {path} {
        set node [lindex $path end]
        if {[dict exists $arcs $node]} {
            lmap next [dict get $arcs $node] {
                if {$next in $to} {
                    lappend good [list {*}$path $next]
                }
                list {*}$path $next
            }
        }
    }
    return $good
}

puts [findpath $arcs a {k l g}]