A page to collect useful [Sugar] macros.

----
'''inlist''' command macro

Expands

 [inlist $list $element]

in

 [expr {[lsearch -exact $list $element] != -1}]

This one was suggested by [Richard Suchenwirth] (but the implementation is mine ([SS]), so even possible bugs):

 sugar::macro inlist argv {
     if {[llength $argv] != 3} {error "Bad number of arguments"}
     list expr \
         "\{\[lsearch -exact [lindex $argv 1] [lindex $argv 2]\] != -1\}"
 }

[AMG]: See also [in], which can be used as a command as well as a math operator in Tcl 8.5.

----
'''tailrec_proc''' transformer

A warpper to [proc] able to optimize tail recursive calls.
For example the following:

 tailrec_proc ack {m n} {
    if {$m == 0} {
        return [expr {$n + 1}]
    } elseif {$n == 0} {
        ack [expr {$m - 1}] 1
    } else {
        ack [expr {$m - 1}] [ack $m [expr {$n - 1}]]
    }
 }

will be equivalent to:

 proc ack {m n} {
    while 1 {
        if {$m == 0} {
            return [expr {$n + 1}]
        } elseif {$n == 0} {
            foreach [list m n] [list [expr {$m - 1}] 1] break
            continue
        } else {
            foreach [list m n] [list [expr {$m - 1}] [ack $m [expr {$n - 1}]]] break
            continue
        }
        break
    }
 }

This is the example in the page [Sugar transformers], but with some bugfix. This new version care a bit more about
indentation and does not use temp variables, but [foreach] to perform multi-assignment (thanks to Richard Suchenwirth for
the idea).

 proc tailrec_proc {name arglist body} {
     # Convert the script into a Tcl list
     set l [sugar::scriptToList $body]
     # Convert tail calls
     set l [tailrec_convert_calls $name $arglist $l]
     # Add the final break
     lappend l [list {TOK break} {EOL "\n"}]
     # Convert it back to script
     set body [sugar::listToScript $l]
     # Add the surrounding while 1
     set body "while 1 {$body}"
     # Call [proc]
     uplevel proc [list $name $arglist $body]
 }
 
 # Convert tail calls. Helper for tailrec_proc.
 # Recursively call itself on [if] script arguments.
 proc tailrec_convert_calls {name arglist code} {
     # Search the last non-null command.
     set lastidx -1
     for {set j 0} {$j < [llength $code]} {incr j} {
         set cmd [lindex $code $j]
         if {[sugar::indexbytype $cmd TOK 0] != -1} {
             set lastidx $j
             set cmdidx [sugar::indexbytype $cmd TOK 0]
         }
     }
     if {$lastidx == -1} {
         return $code
     }
     set cmd [lindex $code $lastidx]
     set cmdname [lindex $cmd $cmdidx 1]
     if {[lindex $cmd 0 0] eq {SPACE}} {
         set space [lindex $cmd 0 1]
     } else {
         set space " "
     }
     if {$cmdname eq $name} {
         #puts "TAILCALL -> $cmdname"
         set recargs [lrange [sugar::tokens $cmd] 1 end]
         set t [list [list SPACE $space] [list TOK foreach] [list SPACE " "]]
         lappend t [list TOK "\[list "]
         foreach a $arglist {
             lappend t [list TOK $a] [list SPACE " "]
         }
         lappend t [list TOK "\] "]
         lappend t [list TOK "\[list "]
         foreach a $recargs {
             lappend t [list TOK $a] [list SPACE " "]
         }
         lappend t [list TOK "\] "]
         lappend t [list TOK break] [list EOL "\n"]
         set code [linsert $code $lastidx $t]
         incr lastidx
         lset code $lastidx [list [list SPACE $space] [list TOK continue] [list EOL "\n"]]
     } elseif {$cmdname eq {if}} {
         #puts "IF CALL"
         for {set j 0} {$j < [llength $cmd]} {incr j} {
             if {[lindex $cmd $j 0] ne {TOK}} continue 
             switch -- [lindex $cmd $j 1] {
                 if - elseif {
                     incr j 2
                 }
                 else {
                     incr j 1
                 }
                 default {
                     set script [lindex $code $lastidx $j 1]
                     #puts "$j -> $script"
                     set scriptcode [sugar::scriptToList [lindex $script 0]]
                     set converted [tailrec_convert_calls $name $arglist $scriptcode]
                     lset code $lastidx $j 1 [list [sugar::listToScript $converted]]
                 }
             }
         }
     }
     return $code
 }

----

'''Math commands as macro'''

Expands

 [+ $a $b $c]

to

 [expr {$a+$b+$c}]

Performs some pre-calculation of the value at compile time when possible.
For example

 [+ [* [+ 1 2] 4] 1]

is expanded to

 [expr 13]

and so on.

NOTE: this macro requires sugar 0.1 to be used, it's availabe for download from the [Sugar] page.

 package require sugar
 
 sugar::macro {+ - / *} {op args} {
     for {set j 0} {$j < [llength $args]} {incr j} {
        # Is the operand in the form [expr {<valid-double>}]?
        # This can be translated to just <valid-double>
        if {[regexp {^\[expr (.*)\]$} [lindex $args $j] => double]} {
            if {[string is double -strict $double]} {
                lset args $j $double
            }
        }
        if {![string is double -strict [lindex $args $j]]} break
     }
     if {$j == [llength $args]} {
        # The expression can be computed at compile-time?
        list expr "[eval expr [join $args $op]]"
     } else {
        list expr "{[join $args $op]}"
     }
 }
 
 sugar::proc test {} {
     puts [* [+ 5 2] 4]
     puts [+ 1]
 }
 
 puts [info body test]
 test

----
[A/AK] is [using sugar for forward-compatible {expand}]
----
[A/AK] work above had inspired to [FM] a math expand syntax extension :
======
# word prefixed by {=} is treated as an expression : ie {=}expression is transformed in [expr {expression}]

sugar::syntaxmacro mathexpand args {
   # The first thing we check: is there anything to expand?
   if {[lsearch $args {{=}?*}]==-1} {
       # and if there is none...
       return $args
    } else {
       set evalCmd []
       foreach token $args {
          # If the arg is expanded
          if {[string match {{=}?*} $token]} {
              set whattoexpand [string range $token 3 end]
              lappend evalCmd "\[expr {$whattoexpand}\]"
          } else {
              # we append a one-element [list]
              # to the eval's argument list
              lappend evalCmd "$token"
          }
      }
      return $evalCmd
   }
}
# test
package require Tk

sugar::proc testmathexpand {} {
   set A [list  {=}([winfo screenwidth .]-[winfo width .])/2 \
                {=}([winfo screenheight .]-[winfo height .])/2]
   return +[join $A +]
}

proc testexpr {} {
   set A [list  [expr {([winfo screenwidth .]-[winfo width .])/2}] \
                [expr {([winfo screenheight .]-[winfo height .])/2}]]
   return +[join $A +]
}
wm geom . [testmathexpand]
wm geom . [testexpr]
time {testmathexpand} 10000 ;# -> 4.7 microseconds per iteration
time {testexpr} 10000; # -> 4.7 microseconds per iteration
======

[AMG]: The empty script substitution [[]] produces empty string, but it's not a very common idiom.  In fact, this is the first time I have seen it used in practice.  Profiling via [time] shows it to be as fast as the alternatives.  In actual code, I've only ever seen "", {}, and sometimes [[list]] on the theory that it slightly reduces [shimmering].  (By the way, I seem to remember there was some controversy over the internal representation of [[list]].)

------
<<categories>>Category Application | Category Dev. Tools | Category String Processing