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\}"
 }

This expands

 inlist $list $foo

in

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

----

'''tailrec_proc''' transformer

A warpper to [proc] able to optimize recursive tail calls.

 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 translated in

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
 }

----