Math sugar

Richard Suchenwirth - When coding for Graph theory in Tcl, I noticed I had to translate mathematical formulations from the book to procedural Tcl code. Routine, yes, but on second look I thought it could be nice to add some sugar (see Salt and sugar) to typical situations: for instance, returning a truth value can be done with a call to expr:

proc isPositive x {expr {$x>0}} 

but as this is the required condition, one could use requires as alias for expr, so it could look like this:

proc isPositive x {requires {$x>0}} 

More typing, but somehow reads nicer... And once started with that, I wanted to factor out testing loops like in isEulerian, which break and return false when the test fails once, or return true after looping over all cases, so I could write:

proc arePositive list {requires all i in $list {isPositive $i}}

Pretty neat for Tcl, huh? And in place for "all", you could place other logical quantifiers like "any, none"... well, just see for yourself:

proc requires {what args} {
    if ![llength $args] {
        uplevel 1 expr $what
    } else {
        foreach {_var "in" list body} $args break
        switch -- $what {
            each - all {set fail 0; set not !}
            one  - any {set fail 1; set not ""}
            no  - none {set fail 0; set not ""}
            default {error "usage: requires Q Var in List Body"}
        }
        upvar 1 $_var var
        foreach var $list {
            if $not[uplevel 1 $body] {return $fail}
        }
        expr !$fail
    }
}

# Here are usage examples for the single and set form, and test code:

proc isEven x {requires {$x%2 == 0}}

proc isOdd  x {requires ![isEven $x] }

proc areEven  list {requires all i in $list {isEven $i}}

proc hasEven  list {requires any i in $list {isEven $i}}

proc areEven2 list {requires no  i in $list {isOdd $i}}

foreach test {
    {isEven 2} {isEven 4711}
    {areEven {2 4 6}} {areEven {2 4 5}} {areEven {}}
    {hasEven {1 3 5}} {hasEven {1 4 5}} {hasEven {}}
    {areEven2 {2 4 6}} {areEven2 {2 4 5}} {areEven2 {}}
} {
    puts "$test:[eval $test]"
}
# The behavior on empty lists leaves something to be wished, though...

Sugared assignment: this version evolved in the Tcl chatroom:

proc let {varName "=" args} {
    upvar 1 $varName v
    set v [uplevel 1 expr $args]
} ;# dkf

See also Let's assign with Let