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 https://wiki.tcl-lang.org/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

[name redacted]: I need to look more at the code before I attempt to explain anything, but right now I'm just amazed it runs at all. Inside the when command you call return with the option after the result argument, which is illegal syntax and should have raised an error. Try defining when like this instead:

proc when {cond body} {
    return -code return [uplevel 1 [list if $cond $body]]
}

This solves your problem with the third test, but breaks the first two tests instead. Good luck! ;)

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]