Version 9 of Cartesian product of a list of lists

Rolf Ade posted a question to the chat asking how to form the Cartesian product of a set of lists. That is, given a list like,

   { { a b c } { d e f } }

he wanted

   {{a d} {a e} {a f} {b d} {b e} {b f} {c d} {c e} {c f}}

He also wanted it to generalize to higher dimension: given

   {{a b} {c d} {e f}}

he wanted

   {{a c e} {a c f} {a d e} {a d f} {b c e} {b c f} {b d e} {b d f}}

and so on.

Kevin Kenny proposed the following:

 proc crossProduct { listOfLists } {
    if { [llength $listOfLists] == 0 } {
         return [list [list]]
     } else {
         set result [list]
         foreach elt [lindex $listOfLists 0] {
             foreach combination [crossProduct [lrange $listOfLists 1 end]] {
                 lappend result [linsert $combination 0 $elt]
             }
         }
         return $result
     }
 }
 puts [crossProduct {{a b c} {d e f} {g h i}}]

This solution is by no means the fastest available, but it appears to work for the purpose.

KBK 2004-07-28: Note that expanding a large Cartesian product can consume large amounts of memory. It's often more useful to iterate some script for each element of the cross product.

Something like the following code gives a rough approximation of a control structure to do so.

 proc rforeach { varlist vallist args } {
     set i 0
     foreach v $varlist {
         set localName x$[incr i]
         lappend localNames $localName
         upvar 1 $v $localName
     }
     foreach $localNames $vallist {
         if { [llength $args] <= 1 } {
             set status [catch {
                 uplevel 1 [lindex $args 0]
             } result]
         } else {
             set status [catch {
                 uplevel 1 [linsert $args 0 rforeach_nested]
             } result]
         }
         if { $status != 0 && $status != 4 } break
     }
     switch -exact -- $status {
         0 - 3 - 4 {
             return
         }
         1 {
             return -code error -errorcode $::errorCode $result
         }
         2 {
             return -code return $result
         }
     }
 }
 proc rforeach_nested { varlist vallist args } {
     set i 0
     foreach v $varlist {
         set localName x$[incr i]
         lappend localNames $localName
         upvar 1 $v $localName
     }
     foreach $localNames $vallist {
         if { [llength $args] <= 1 } {
             set status [catch {
                 uplevel 1 [lindex $args 0]
             } result]
         } else {
             set status [catch {
                 uplevel 1 [linsert $args 0 rforeach_nested]
             } result]
         }
         if { $status != 0 && $status != 4 } break
     }
     switch -exact -- $status {
         0 - 4 {
             return
         }
         1 {
             return -code error -errorcode $::errorCode $result
         }
         2 {
             return -code return $result
         }
         3 {
             return -code break
         }
     }
 }
 rforeach a {a1 a2} b {b1 b2 b3} {c d} {c1 d1 c2 d2} e e1 {
     puts [list $a $b $c $d $e]
     if { $b eq {b3} } continue
     puts "b isn't b3; didn't continue"
     if { $a eq {a2} } break
     puts "a isn't a2; didn't break"
 }