Amb: Difference between revisions
Content added Content deleted
(→{{header|Tcl}}: renamed 'fit' to 'joins', for better comparison with other languages) |
(→{{header|Tcl}}: Added a coroutine-based version) |
||
Line 439: | Line 439: | ||
} |
} |
||
}</lang> |
}</lang> |
||
A more sophisticated using Tcl 8.6's coroutine facility that avoids the assumption of what the problem is in the code structure: |
|||
<lang Tcl> |
|||
proc cp {args} { |
|||
coroutine cp.[incr ::cps] apply {{list args} { |
|||
yield [info coroutine] |
|||
foreach item $list { |
|||
if {[llength $args]} { |
|||
set c [cp {*}$args] |
|||
while 1 { yield [list $item {*}[$c]] } |
|||
} else { yield $item } |
|||
} |
|||
return -code break |
|||
}} {*}$args |
|||
} |
|||
proc amb {name filter args} { |
|||
coroutine $name apply {{filter args} { |
|||
set c [cp {*}$args] |
|||
yield [info coroutine] |
|||
while 1 { |
|||
set value [$c] |
|||
if {[{*}$filter $value]} { yield $value } |
|||
} |
|||
return -code break |
|||
}} $filter {*}$args |
|||
} |
|||
proc joins {a b} { |
|||
expr {[string index $a end] eq [string index $b 0]} |
|||
} |
|||
proc joins* list { |
|||
foreach a [lrange $list 0 end-1] b [lrange $list 1 end] { |
|||
if {![joins $a $b]} {return 0} |
|||
} |
|||
return 1 |
|||
} |
|||
amb words joins* \ |
|||
{the that a} \ |
|||
{frog elephant thing} \ |
|||
{walked treaded grows} \ |
|||
{slowly quickly} |
|||
while 1 { puts [words] } |
|||
</lang> |