A list comprehension is a shorthand style of constructing lists from other lists.
pyk 2013-08-04: modified main script to take accept multiple conditions, and changed both the conditions and the expression from scripts to [expr]essions. Changed the name of RS proc from "all" to "select". Modified CMcC's variant to make code generation more robust.
From Haskell: The Craft of Functional Programming by Simon Thompson:
In a list comprehension we write down a description of a list in terms of the elements of another list. From the first list we generate elements, which we test and transform to form elements of the result.
Playing Haskell has an interesting Tcl take on list comprehensions. Here is another:
#! /bin/env tclsh
# Synopsis:
# listc expression vars1 <- list1 [.. varsN <- listN] [condition].
#
proc listc {expression var1 <- list1 args} {
set res {}
# Conditional expression (if not supplied) is always 'true'.
set condition {expr 1}
# We should at least have one var/list pair.
lappend var_list_pairs $var1 $list1
# Collect any additional var/list pairs.
while {[llength $args] >= 3 && [lindex $args 1] == "<-"} {
lappend var_list_pairs [lindex $args 0]
# skip "<-"
lappend var_list_pairs [lindex $args 2]
set args [lrange $args 3 end]
}
# Build the foreach commands (for each var/list pair).
foreach {var list} $var_list_pairs {
append foreachs [string map [list \${var} [list $var] \${list} \
[list $list]] "foreach \${var} \${list} \{
"]
}
# Remaining args are conditions
# Insert the conditional expression.
append foreachs [string map [list \${conditions} [list $args] \
\${expression} [list $expression]] {
set discard 0
foreach condition ${conditions} {
if !($condition) {
set discard 1
break
}
}
if {!$discard} {
lappend res [expr ${expression}]
}
}]
# For each foreach, make sure we terminate it with a closing brace.
foreach {var list} $var_list_pairs {
append foreachs \}
}
# Evaluate the foreachs...
eval $foreachs
return $res
} Here are some examples:
set i [list 1 2 3 4 5 6]
set l2 [listc {$i} i <- $i]
puts "A copy of the list: $l2"output:
A copy of the list: 1 2 3 4 5 6
set dbl [listc {$n*2} n <- $i]
puts "Double values from list: $dbl"output:
Double values from list: 2 4 6 8 10 12
set evn [listc {$i} i <- $i {$i%2 == 0}]
puts "Only even numbers: $evn"output:
Only even numbers: 2 4 6
proc digits {str} {
set lstr [split $str ""]
return [listc {$d} d <- $lstr {[string is digit $d]}]
}
puts "Just digits from (703)-999-0012 = [digits (703)-999-0012]"output:
Just digits from (703)-999-0012 = 7 0 3 9 9 9 0 0 1 2
set names1 [list Todd Coram Bob Jones Tim Druid]
set lf [listc {[list "$l,$f"]} {f l} <- $names1]
puts "From ($names1)\n\tLast,first = $lf"output:
From (Todd Coram Bob Jones Tim Druid)
Last,first = Coram,Todd Jones,Bob Druid,Timset l3 [listc {$f} {f l} <- $names1 {[string match "T*" $f]}]
puts "From ($names1)\n\tOnly names starting with 't': $l3"output:
From (Todd Coram Bob Jones Tim Druid) Only names starting with 't': Todd Tim''
Now, let's get fancy. Given a proc like lisp's setp and a simple lambda:
proc lset {vars {values {}}} {
if {$values == {}} {
foreach var $vars {
lappend values [uplevel set $var]
}
return $values
}
uplevel [list foreach $vars $values break]
return $values
}
proc lambda {arglst body} {
set name [string map {" " _ $ _} [info level 0]]
proc $name $arglst $body
set name
}You can get even more functional:
set names2 [list {Todd Coram} {Bob Jones} {Tim Druid}]
set lf [listc {[[lambda nm {lset {f l} $nm; return "$l,$f"}] $n]} n <- $names2]
puts "From ($names2)\n\tAnother last,first = $lf"output:
From ({Todd Coram} {Bob Jones} {Tim Druid})
Another last,first = Coram,Todd Jones,Bob Druid,TimThis listc proc also supports multiple (nesting) list variables:
set l4 [listc {[list $n1 $n2]} n1 <- [list a b c] n2 <- [list 1 2 3]]
puts "Create a matrix pairing {a b c} and {1 2 3}: \n\t$l4"output:
Create a matrix pairing {a b c} and {1 2 3}:
{a 1} {a 2} {a 3} {b 1} {b 2} {b 3} {c 1} {c 2} {c 3}RS: has this sugary list comprehension:
proc select {varName from list where condition} {
upvar 1 $varName var ;# import into local scope
set res {}
foreach var $list {
if {[uplevel 1 expr $condition]} {
lappend res $var
}
}
return $res
}% select i from {1 0 3 -2 4 -4} where {$i>1}
3 4
% select k from {1 0 3 -2 4 -4} where {$k<1}
0 -2 -4This allows calls somehow resembling SQL:
% array set income {Jim 1234 Jack 2345 Bill 3456789}
% select i from [array names income] where {$income($i) > 2000}
Jack BillDKF: Ah, so it is a striding cross between the map and filter functional operations?
Duoas: I very much like RS's select there. Here is another version which, while a little less pretty, gives you the ability to bind on multiple variables (much like a single-list foreach):
proc select {varNames from list where condition} {
foreach varName $varNames {
upvar 1 $varName $varName
}
set result {}
foreach $varNames $list {
if {[uplevel 1 expr $condition]} {
set ls [list]
foreach varName $varNames {
lappend ls [set $varName]
}
lappend result $ls
}
}
return $result
}And a simple example:
% array set income {Jim 1234 Jack 3456 Bill 3456789}
% select {name salary} from [array get income] where {$salary > 2000}
{Jack 3456} {Bill 3456789}Notice how there is nothing wrong with using the same name for the local variable as the external frame's variable when using upvar. Also notice that the original example works the same:
% select i in [array names income] where {$income($i) > 2000}
Jack Bill(I have specifically avoided constructs available only in modern versions of Tcl.)
Another variant, from CMcC 2010-07-01 10:14:25, modified by pyk 2013-08-04:
Unlike the main script on this page, this variant iterates over the lists simultaneously, in the manner of [foreach] rather than treating them as nested [foreach] commands.
Each list is given a positional variable $0...$n in the expression
proc com {expr args} {
::set vars {}
::set foreachs {}
::set i -1
while {[llength $args] >= 3 && [lindex $args 1] == {<-}} {
dict set foreachs [lindex $args 0] [lindex $args 2]
lappend vars "\[set [list [lindex $args 0]]]"
set args [lrange $args 3 end]
}
foreach {*}$foreachs {
::set vals [subst $vars]
set keep 1
foreach condition $args {
if {![uplevel 1 [list ::apply [list [dict keys $foreachs] \
[list expr $condition]] {*}$vals]]} {
set keep 0
break
}
}
if {$keep} {
lappend result [::uplevel 1 [list ::apply [list [dict keys $foreachs] [list expr $expr]] {*}$vals]]
}
}
return $result
}puts [com {$x + $y} x <- {1 2 3} y <- {4 5 6} {$y > 5}]output:
9