A page to collect useful Sugar macros.
inlist command macro
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
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
}