Updated 2016-03-21 03:39:29 by pooryorick
# let.tcl
# Copyright 2001 by Larry Smith
# Wild Open Source, Inc
# For license terms see "COPYING"
#
# let is a replacement for the "set" command.  It allows
# multiple assignment, and supports a variety of assignment
# operators:
#
# let a b c = 1     ;#  this sets a b and c to 1
# let a b c = 1 + 4 ;# "=" uses expr to process the value to assign
# let a b c += 1    ;# computed assignments allowed, +-*/&| supported
# let a b c := info commands ;# uses eval to process value
# let a b c @= 1 2 3;# "hoisting" assignment, foreach replacement
# let a b c @:= info commands;# uses eval and hoists for assignment
# let a ++          ;# incr and
# let a --          ;#   decr are supported.

proc let { args } {
  if { [llength $args ] == 2 } {
    if [string equal [ lindex $args 1 ] "++" ] {
      set result [ uplevel incr [ lindex $args 0 ] ]
    } elseif [string equal [ lindex $args 1 ] "--" ] {
      set result [ uplevel incr [ lindex $args 0 ] -1 ]
    } else {
      set result [ uplevel set "$args" ]
    }
  } else {
    regexp {([^=:+\-*/&|@]*)([:+\-*/&|@]?)([@]*)=(.*)} $args -> vars op optional rest
    if ![ info exists op ] {
      return -code error -errorcode 1 "no valid assignment operator in $args"
    }
    switch -- $op {
      : {
        if [llength [info commands [lindex $rest 0]]] {
          set result [uplevel $rest]
        } else {
          set result $rest                ;# this should always work...
        }
        if { "$optional" == "@" } {
          set max [ llength $result ]
          foreach var $vars res $result {
            uplevel 1 [ list set $var $res ]
          }
        } else {
          foreach var $vars {
            set result [ uplevel set $var \"$result\" ]
          }
        }
      }
      @ {
        if { "$optional" == ":" } {
          set rest [uplevel $rest]
        }
        set max [ llength $rest ]
        if { $max == 1 } {
          eval set rest $rest
          set max [ llength $rest ]
        }
        foreach var $vars res $rest {
          set result [ uplevel 1 [ list set $var $res ]]
        }
      }
      + - - - * - / - & - | {
        foreach var $vars {
          set result [ uplevel set $var \[ expr \$$var $op ( $rest ) \] ]
        }
      }
      = -
      default {
        if { [ catch { set result [ uplevel expr $rest ] } ] } {
          set result $rest              ;# this should always work...
        }
        foreach var $vars {
          set result [ uplevel set $var \"$result\" ]
        }
      }
    }
  }
  return $result
}

if {[info exists argv0] && [
    file dirname [file normalize [info script]/...]] eq [
    file dirname [file normalize $argv0/...]]} {

    namespace eval test {
        namespace import [namespace parent]::let
        package require tcltest
        namespace import ::tcltest::*

        set cleanup {
            catch {unset a b c}
        }

        test basic {} -body {
            let a b c = 1
            list $a $b $c
        } -cleanup $cleanup -result {1 1 1}
            
        test expr {} -body {
            let a b c = 1 + 4
            list $a $b $c
        } -cleanup $cleanup -result {5 5 5}

        test computed {} -body {
            set a 2
            set b 3 
            set c 7
            let a b c += 1
            list $a $b $c
        } -cleanup $cleanup -result {3 4 8}

        test eval {} -body {
            let a b c := list one two three
            list $a $b $c
        } -cleanup $cleanup -result {{one two three} {one two three} {one two three}}

        test hoist {} -body {
            let a b c @= 1 2 3
            list $a $b $c
        } -cleanup $cleanup -result {1 2 3}

        test evalhoist {} -body {
            let a b c @:= list one two three
            list $a $b $c
        } -cleanup $cleanup -result {one two three}

        test incr {} -body {
            set res {}
            let a ++
            lappend res $a
            let a ++
            lappend res $a
            let a ++
            let a ++
            lappend res $a
            let a --
            lappend res $a
            return $res
        } -cleanup $cleanup -result {1 2 4 3}


        cleanupTests
    }
}

DKF - I'd prefer it if stand-alone = was not used, but rather always working with := instead. That's proved to work fairly well. And automagic passing of stuff through eval is not necessary; better to get people to say what they mean IMHO.

Larry Smith The '=' comes from both C and Basic, from which came "let". While a personally agree with you, the vast plethora of C's spawn have placed the equals sign forevermore as the "typical" assignment operator. As for use of eval, the design was intended to remove visual cruft. Making eval explicit just makes it harder to read.

Recently someone on comp.lang.tcl asked about the use of the word hoisting above. What is its meaning in this context?

AMG: Multiple assignments in the style of [foreach] or [lassign]: variables are set to corresponding values, where correspondence is determined by list position. [let a b c @= 1 2 3] would be like [foreach {a b c} {1 2 3} {break}] or [lassign {1 2 3} a b c].

What is the expected output of
  let a b c @:= info commands;# uses eval and hoists for assignment

What I am seeing, with the above code, is that nothing whatsoever is being done.

PYK 2016-03-19: Can confirm. I attempted to fix this bug today, but after working with it for a bit, decided that this code has too many issues to salvage. The alleged functionality has been largely implemented in lassign these days anyway. I move to delete this entire page on 2016-03-31.

HE 2016-03-20: Hello PYK no one asked you to fix the code. So, instead to delete the side you should consider to explain other readers what is wrong with this code. In particular because lassign could only replace one of the different ways you can call the code above:

Larry Smith "Let" was suggested before lassign was added to the language. As for "bugs" and "not working", using exactly the above code I executed
 let a b c @= {1 2 3}
 puts "a=$a, b=$b c=$c"

and got exactly what I advertised. If you don't find it intuitive, that's your taste, but that doesn't mean it's broken.
 $ tcl temp.tcl
 a=1, b=2 c=3
set l [list 1 2 3]
let a b c @= $l
puts "$a $b $c"

is simimlar to
set l [list 1 2 3]
lassign $l a b c
puts "$a $b $c"

But in case someone wants a single value assign to more than one variable
let a b c := [expr {4 * 4 * 5}]
puts "$a $b $c"

you have to use a help variable. For sure the expression could be more complex for example relay on other variables.
set tmp [expr {4 * 4 * 5}]
lassign [list $tmp $tmp $tmp] a b c
puts "$a $b $c"

or perhaps something like
set a [set b [set c [expr {4 * 4 * 5}]]]

I can see that the code has some quirks and perhaps errors, too. But why deleting the page?

PYK 2016-03-20: I sort of assumed the author of this program had long-since drifted off, and that no one would be around to explain what looked broken, much less to work on it, if needed, but since you're here "in the flesh", I move to quash my motion to delete the page. I had worked up a test suite, and have taken the liberty of posting into the code above (if that's not to your taste feel free to move it off into its own code section or do whatever you'd like with it). You'll see that it fails in the evalhoist test:
let a b c @:= list one two three
list $a $b $c

I surmised from the code that it should be possible to provide the optional operator parts in any order:
let a b c :@= list one two three
list $a $b $c

But that doesn't work either at the moment.

Also, one of the examples above was:
let a b c := [expr {4 * 4 * 5}]

Shouldn't that be:
let a b c := expr {4 * 4 * 5}

?

See also  edit

let - a simpler sugar for expr
C-style arithmetic operations for assignments.