Version 0 of Another try at COND.

Again, in Ask-11 I ended up answering my own question. The question here was simply looking for a neater, tidier alternative to an 'if/elseif/elseif/elseif...' chain. The problem is to take the first and only the first matching choice from potentially overlapping boolean tests. Either of the solutions in [L1 ] or [L2 ] would have been fine - but I wanted to have a go myself. I ran into a problem - due to my own stupidity, then asked for help, then solved the problem anyway.

Here is the original question:

I would like a 'choose the first match' functionality, similar to http://wiki.tcl.tk/3297 . Rather than just use other people's work I thought that it might be a good opportunity to learn the subtler points of return and uplevel. Despite ages re-reading manual entries I cannot work out where I am going wrong. I would expect the third test here to simply print '1' - but it actually prints 1 2 and 3, which seems to indicate that the '-code return' from when is not being actioned. Can anyone explain to me why? Many thanks, RJH

proc when {cond body} {
    return [uplevel 1 [list if $cond $body]] -code return
}
proc case code {return [uplevel 1 $code]}
proc check {a b} {
    puts before
    case {
        when {$a && $b} {puts 1}
        when {$a} {puts 2}
        when {$b} {puts 3}
    }
    puts after
}
check 0 1
check 1 0
check 1 1

... and now my attempt a solution. This now passes my very simple tests:

• Does it run the correct code?
• Does it return the correct value?

but I welcome comments as to whether this is a good approach:

proc when {cond body} {
    set x [uplevel 1 expr $cond]
    if {$x} {return -code return [uplevel 1 $body]}
}

proc case code {return [uplevel 1 $code]}

proc check {a b} {
    puts before
    case {
        when {$a && $b} {puts 1}
        when {$a}       {puts 2}
        when {$b}       {puts 3}
    }
    puts after
}

check 0 1
check 1 0
check 1 1


proc check2 "a b" {
puts "check2 $a $b"
  case {
    when {$a && $b} {puts "Caught1 $a $b"; expr 10}
    when {$a}       {puts "Caught2 $a $b"; expr 11}
    when {$b}       {puts "Caught3 $a $b"; expr 12}
  }
}

puts [check2 0 1]
puts [check2 1 0]
puts [check2 1 1]