sugar/0042755000175000017500000000000010031004010012072 5ustar antirezantirezsugar/INSTALL0100644000175000017500000000023210030547071013135 0ustar antirezantirezMANUAL INSTALL - Copy the directory named "sugar0.1" in a place where your Tcl/Tk install will search for. Under unix it's "/usr/lib" in many cases. sugar/example/0042755000175000017500000000000010031003770013541 5ustar antirezantirezsugar/example/example1.tcl0100644000175000017500000000104410030551272015757 0ustar antirezantirez# Sugar example 1 - simple "command macros". package require sugar sugar::macro first {cmd list} { list lindex $list 0 } sugar::macro second {cmd list} { list lindex $list 1 } sugar::macro last {cmd list} { list lindex $list 1 } sugar::macro rest {cmd list} { list lrange $list 1 end } sugar::proc testit {} { set list [list 1 2 3] puts [first $list] puts [second $list] puts [rest $list] puts [first [rest $list]] } puts "The body of 'testit' procedure is:" puts [info body testit] puts "Output:" testit sugar/example/dictsugar.tcl0100644000175000017500000000420710031003770016230 0ustar antirezantirez# Syntax sugar for [dict]. # Copyright(C) 2004 Salvatore Sanfilippo # # Performed expansions: # # From: # mydict<-a.$b.c $newval # # To: # dict set mydict a $b c $newval # # This expansion only works if the "<-" form is the first argument # of a command. # # From: # puts $mydict->a.$b.c # # To: # puts [dict get $mydict a $b c] # # This expansion only works if the "->" form is one argument # of a command in any position, but not with general interpolation. # To use the "->" form in any case, like inside "" quotation, use # [format], like in: # # puts "[format %s%s $mydict->a $mydict->b]" package require sugar package require Tcl 8.5 sugar::syntaxmacro dictsugar args { for {set i 0} {$i < [llength $args]} {incr i} { set tok [lindex $args $i] set level 0 set idx {} set keyidx {} for {set j 0} {$j < [string length $tok]} {incr j} { set current [string index $tok $j] set next [string index $tok [expr {$j+1}]] switch -- $current { "\\" {incr j} "\[" {incr level} "\]" {if {$level > 0} {incr level -1}} "-" { if {$level == 0 && [llength $idx] == 0 && $next eq {>}} { set idx $j set type get } } "<" { if {$level == 0 && [llength $idx] == 0 && $next eq {-}} { set idx $j set type set } } "." { if {$level == 0 && [llength $idx]} { lappend keyidx [expr {$j-$idx-3}] } } } } if {[llength $idx]} { lappend keyidx [expr {$j-$idx-3}] set left [string range $tok 0 [expr {$idx-1}]] set right [string range $tok [expr {$idx+2}] end] #puts "$left ... $type ... $right ($keyidx)" set keypath {} set startidx 0 foreach k $keyidx { lappend keypath [string range $right $startidx $k] set startidx [expr {$k+2}] } if {$type eq {get}} { lset args $i "\[dict get $left [join $keypath]\]" } elseif {$type eq {set} && $i == 0} { set value [lindex $args [expr {$i+1}]] set args [list dict set $left] foreach k $keypath { lappend args $k } lappend args $value } } } return $args } sugar::proc test {} { foreach k {foo bar foobar helloworld} { dict<-$k "Hello $k" puts $dict->$k } } test sugar/example/tailcall.tcl0100644000175000017500000000023610030777247016046 0ustar antirezantirezpackage require sugar sugar::tailrecproc printlist l { if {[llength $l]} { puts [lindex $l 0] printlist [lrange $l 1 end] } } printlist {1 2 3 4} sugar/example/example2.tcl0100644000175000017500000000057610031003745015767 0ustar antirezantirezpackage require sugar sugar::macro inlist {name list element} { list expr "\{\[lsearch -exact $list $element\] != -1\}" } sugar::proc test {} { set list {tcl c ada python scheme forth joy smalltalk} foreach lang {pascal scheme php ada tcl} { if {[inlist $list $lang]} { puts "$lang is in the list" } else { puts "$lang is not in the list" } } } test sugar/sugar0.1/0042755000175000017500000000000010030777436013466 5ustar antirezantirezsugar/sugar0.1/pkgIndex.tcl0100644000175000017500000000103610030543260015720 0ustar antirezantirez# Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex -direct" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. package ifneeded sugar 0.1 [list source [file join $dir sugar.tcl]] sugar/sugar0.1/sugar.tcl0100644000175000017500000005064210030777436015315 0ustar antirezantirez# Sugar - a macro system for Tcl # Copyright (C) 2004 Salvatore Sanfilippo # Under the same license as Tcl version 8.4 ### Changes # # 25Mar2004 - Added support for unique identifiers (sugar::uniqueName). # 25Mar2004 - Now macros can specify a list of arguments instead of # a unique argument that will receive a list. For old behaviour # just use 'args'. # 24Mar2004 - Modified the tailcal_proc transformer to use [foreach] for # multiple assignments instead to create temp vars. Thanks # to Richard Suchenwirth for the suggestion. ### TODO # # - better macro error reporting (line numbers). # - call the macro system recursively for variable expansions? # this allows to expand syntax that have to deal with # variables interpolated inside other strings. (probably not). # - Write a better macro for [switch] using sugar::scriptToList. # - Write a macro that convert a subset of Tcl to critcl. # - sugar::interleaveSpace should remove spaces before the first # element of type TOK from the original parsed command. # This is not needed for simple macro expansion because the # sugar::expand function does this automatically, but it's needed # when playing raw with the output of sugar::scriptToList. # - Investigate on indentation changes with the tailrec macro # (DONE: Fixed thanks to another related bug found by NEM). # - An API to provide unique variable names for macro expansions. package provide sugar 0.1 namespace eval sugar {} namespace eval sugar::macro {} namespace eval sugar::syntaxmacro {} namespace eval sugar::transformermacro {} # An incremental id used to create unique identifiers. set sugar::unique_id 0 # This global variable contains the name of the procedure being # expanded. set sugar::currentprocedure {} # Return the fully-qualified name of the current procedure. proc sugar::currentProcName {} { return $sugar::currentprocedure } # Return the "tail" of the current procedure name. proc sugar::currentProcTail {} { namespace tail $sugar::currentprocedure } # Return the namespace of the current procedure name. proc sugar::currentProcNamespace {} { namespace qualifiers $sugar::currentprocedure } # Return an unique identifier that macros can use as variable/proc names. proc sugar::uniqueName {} { set id [incr sugar::unique_id] return __sugarUniqueName__$id } # Initialize the state of the interpreter. # Currently this parser is mostly stateless, it only needs # to save the type of the last returned token to know # if something starting with '#' is a comment or not. proc sugar::parserInitState statevar { upvar $statevar state set state [list EOL] } # The parser. It does not discard info about space and comments. # The return value is the "type" of the token (EOF EOL SPACE TOKEN). # # It may be interesting to note that this is half of a simple # Tcl interpreter. variable expansions is ignored, while command # expansion is performed expanding macros if needed. # # The fact that it is still so simple, compared to what it can # be in Python just to say one (much worst in Perl), it's an advice # that to add syntax to Tcl is a bad idea. proc sugar::parser {text tokenvar indexvar statevar {dosubst 0}} { upvar $tokenvar token $indexvar i $statevar state set token {} set inside {} set dontstop $dosubst while 1 { # skip spaces while {!$dontstop && [string match "\[ \t\]" [string index $text $i]]} { append token [string index $text $i] incr i } # skip comments if {$state eq {EOL} && !$dontstop && [string equal [string index $text $i] #]} { while {[string length [string index $text $i]] && ![string match [string index $text $i] \n]} \ { append token [string index $text $i] incr i } } # return a SPACE token if needed if {[string length $token]} {return [set state SPACE]} # check for special conditions if {!$dontstop} { switch -exact -- [string index $text $i] { {} {return [set state EOF]} {;} - "\n" { append token [string index $text $i] incr i return [set state EOL] } } } # main parser loop while 1 { switch -exact -- [string index $text $i] { {} break { } - "\t" - "\n" - ";" { if {!$dontstop} { break; } } \\ { incr i append token \\ [string index $text $i] incr i continue } \" { if {[string equal $inside {}]} { incr dontstop set inside \" append token \" incr i continue } elseif {[string equal $inside \"]} { incr dontstop -1 set inside {} append token \" incr i continue } } "\{" { if {[string equal $inside {}]} { incr dontstop set inside "\{" append token "\{" incr i continue } elseif {[string equal $inside "\{"]} { incr dontstop } } "\}" { if {[string equal $inside "\{"]} { incr dontstop -1 if {$dontstop == 0} { set inside {} append token "\}" incr i continue } } } \$ { if {![string equal $inside "\{"]} { if {![string equal [string index $text [expr {$i+1}]] $]} { set res [LctSubstVar $text i] append token "$$res" continue } } } \[ { if {![string equal $inside "\{"]} { set res [LctSubstCmd $text i] append token "\[$res\]" continue } } } append token [string index $text $i] incr i } return [set state TOK] } } # Actually does not really substitute commands, but # exapands macros inside. proc LctSubstCmd {text indexvar} { upvar $indexvar i set go 1 set cmd {} incr i while {$go} { switch -exact -- [string index $text $i] { {} break \[ {incr go} \] {incr go -1} } append cmd [string index $text $i] incr i } set cmd [string range $cmd 0 end-1] return [::sugar::expand $cmd] } # Get the control when a '$' (not followed by $) is encountered, # extract the name of the variable, and return it. proc LctSubstVar {text indexvar} { upvar $indexvar i set dontstop 0 set varname {} incr i while {1} { switch -exact -- [string index $text $i] { \[ - \] - "\t" - "\n" - "\"" - \; - \{ - \} - \$ - ( - ) - { } - "\\" - {} { if {!$dontstop} { break } } ( {incr dontstop} ) {incr dontstop -1} default { append varname [string index $text $i] } } incr i } return $varname } # Return the number of lines in a string proc countlines {string} { llength [split $string "\n"] } # interleave SPACE and EOL tokens in a Tcl list $tokens # representing a command. Also every token is # converted to the two-elements list representation # with type TOK. # # The $origargv list is the output of the parser # for that command, and is used by interleaveSpaces # to make the indentation of the expanded macro as # similar as possible to what the used typed in the source # code. proc sugar::interleaveSpaces {tokens origargv} { set newargv {} for {set j 0} {$j < [llength $tokens]} {incr j} { lappend newargv [list TOK [lindex $tokens $j]] set idx [::sugar::indexbytype $origargv SPACE $j] if {$idx == -1} { lappend newargv [list SPACE " "] } else { # If possible, try to use the same argument # separator as the user typed it. lappend newargv [lindex $origargv $idx] } } # Use the same EOL string. That's always possible if {![llength $newargv]} { set newargv [list ";"] } lset newargv end [lindex $origargv end] return $newargv } # Tranform a script to a list of lists, where every list is # a command, and every element of the list is an argument, # and is itself a two elements of list. The first element # is the token type, the second the toke value. The following # toke types are defined. # # SPACE - Spaces, non significative for the execution, just separate arguments. # TOK - Any significative token. The first element of type TOK is # the command name. # EOL - End of line. # # This function is intended to be used directly or indirectly by macro, # that will do the processing, and then call listToScript to convert # it back in script. # # Macros may want to call sugar::tokens for every command to work # more comfortably with it, and than reconvert to the # original format with sugar::interleaveSpaces. # # ---------------------------------------------------------------------- # In theory sugar::expand should be modified to directly use this # instead of a local copy of almost the same code. They are actually # a bit different because sugar::expand does the processing for every # command, not in the entire script at once. proc sugar::scriptToList script { set i 0 set result {} ::sugar::parserInitState parserState set eof 0 while 1 { set command {} while 1 { set type [::sugar::parser $script token i parserState] switch $type { EOF {lappend command [list EOL {}]; set eof 1; break} default { lappend command [list $type $token] if {$type eq {EOL}} break } } } lappend result $command if {$eof} break } return $result } # That's really trivial ;) # The macro specification should guarantee that the list # is transformed into the source code by simple concatenation # of all the tokens. proc sugar::listToScript list { set result {} foreach c $list { foreach t $c { append result [lindex $t 1] } } return $result } # Return true if the named macro exists, and store in macroName var # the fully qualified name of the procedure in charge to do expansion for it. proc sugar::lookupMacro {macroname procnameVar} { upvar 1 $procnameVar procname if {[catch {info args ::sugar::macro::__macroproc__$macroname}]} { return 0 } set procname ::sugar::macro::__macroproc__$macroname return 1 } # Macro expansion. It trys to take indentation unmodified. proc sugar::expand script { while 1 { set eof 0 set i 0 set result {} ::sugar::parserInitState parserState while {!$eof} { set argv {} set argc 0 # Collect a command in $argv. Every token is a two-elements # List with the token type and value, as returned by expr. # Significative tokens are interleaved with space tokens: # syntax macros will have a way to know how arguments where # separated. while 1 { set type [::sugar::parser $script token i parserState] if {[string equal $type EOF]} { set eof 1 } switch $type { EOF {lappend argv [list EOL {}]; break} default { if {$type eq {SPACE} && $argc == 0} { append result $token } else { lappend argv [list $type $token] incr argc if {$type eq {EOL}} break } } } } # Call macros for this statement if {[lindex $argv 0 0] ne {EOL}} { # Check if there is a macro defined with that name set cmdname [lindex $argv 0 1] # Call the macro associated with that command name, if any. if {[sugar::lookupMacro $cmdname expander]} { #puts "executing macro for $cmdname in procedure [::sugar::currentProcName]" if {[catch {set tokens [eval $expander [::sugar::tokens $argv]]} errstr]} { error "Macro '$cmdname' expansion error in procedure '$::sugar::currentprocedure': $errstr" $::errorInfo } set argv [::sugar::interleaveSpaces $tokens $argv] } # Call all the syntax macros. For now in random order. foreach syntaxmacro [info command ::sugar::syntaxmacro::__macroproc__*] { set argv [::sugar::interleaveSpaces [eval $syntaxmacro [::sugar::tokens $argv]] $argv] } } foreach arg $argv { append result "[lindex $arg 1]" } } # Call all the transformer macros. For now in random order. # TODO: consider if it's better to move this as first # transformation. foreach trmacro [info command ::sugar::transformermacro::__macroproc__*] { set list [::sugar::scriptToList $result] set list [$trmacro $list] set result [::sugar::listToScript $list] } # Reiterate if needed, otherwise exit. if {[string equal $script $result]} break #puts "AFTER: '$script'" #puts "BEFORE: '$result'" #puts "---" set script $result } return $result } # Return the index of the $num-Th element of type $type in a list # of tokens. proc ::sugar::indexbytype {argv type num} { set idx 0 foreach a $argv { foreach {t _} $a break if {$type eq $t} { if {!$num} { return $idx } incr num -1 } incr idx } return -1 } # Wrapper for [proc] that expands macro in the body # TODO: add a switch -nomacro to avoid macro expansion # for the given procedure. proc sugar::proc {name arglist body} { # Get the fully qualified name of the proc set ns [uplevel [list namespace current]] # If the proc call did not happen at the global context and it did not # have an absolute namespace qualifier, we have to prepend the current # namespace to the command name if { ![string equal $ns "::"] } { if { ![string match "::*" $name] } { set name "${ns}::${name}" } } if { ![string match "::*" $name] } { set name "::$name" } set oldprocedure $::sugar::currentprocedure set ::sugar::currentprocedure $name # puts "+ $name" set body [::sugar::expand $body] # Call the real [proc] command. uplevel 1 [list ::proc $name $arglist $body] set ::sugar::currentprocedure $oldprocedure return } # Number of tokens of type TOK. Useful for arity checking in macros. proc sugar::tokensnum argv { set c 0 foreach a $argv { if {[lindex $a 0] eq {TOK}} { incr c } } return $c } # Return values of all the tokens of type TOK as a list. proc sugar::tokens argv { set tokens {} foreach a $argv { if {[lindex $a 0] eq {TOK}} { lappend tokens [lindex $a 1] } } return $tokens } # Define a new macro proc sugar::macro {names arglist body} { foreach name $names { uplevel 1 [list ::proc ::sugar::macro::__macroproc__$name $arglist $body] } } # Define a new syntax macro proc sugar::syntaxmacro {name arglist body} { uplevel 1 [list ::proc ::sugar::syntaxmacro::__macroproc__$name $arglist $body] } # Define a new transformer macro proc sugar::transformermacro {name arglist body} { uplevel 1 [list ::proc ::sugar::transformermacro::__macroproc__$name $arglist $body] } # That's used to create macros that expands arguments that are # scripts. This kind of macros are used for [while], [for], [if], # and so on. proc sugar::expandScriptToken tok { set t [lindex $tok 0] set res [::sugar::expand $t] if {[string equal $t $res]} { return $tok } else { list $res } } # Macro substitution. Like [subst] but for macros. proc sugar::dosubst string { sugar::parserInitState state set idx 0 sugar::parser $string result idx state 1 return $result } # Expand Expr's expressions. Try to don't mess with quoting. proc sugar::expandExprToken tok { set quoted 0 if {[string index $tok 0] == "\{" && [string index $tok end] == "\}"} { set quoted 1 set tok [string range $tok 1 end-1] } set tok [sugar::dosubst $tok] if {$quoted} { set tok "{$tok}" } return $tok } # Get the N-th element with type $type from the list of tokens. proc sugar::gettoken {argv type n} { set idx [::sugar::indexbytype $argv $type $n] if {$idx == -1} { error "bad index for gettoken (wrong number of args for macro?)" } lindex $argv $idx 1 } # Set the N-th $type element in the list of tokens to the new $value. proc sugar::settoken {argvVar type n value} { upvar $argvVar argv set idx [::sugar::indexbytype $argv $type $n] if {$idx == -1} { error "bad index for gettoken (wrong number of args for macro?)" } lset argv $idx 1 $value } ################################################################################ # Macros to allow macros inside conditionals, loops and other Tcl commands # that accept scripts or [expr] expressions as arguments. ################################################################################ sugar::macro while args { lset args 1 [sugar::expandExprToken [lindex $args 1]] lset args 2 [sugar::expandScriptToken [lindex $args 2]] } sugar::macro foreach args { lset args end [sugar::expandScriptToken [lindex $args end]] } sugar::macro time args { lset args 1 [sugar::expandScriptToken [lindex $args 1]] } sugar::macro if args { lappend newargs [lindex $args 0] lappend newargs [sugar::expandExprToken [lindex $args 1]] set args [lrange $args 2 end] foreach a $args { switch -- $a { else - elseif { lappend newargs $a } default { lappend newargs [sugar::expandScriptToken $a] } } } return $newargs } sugar::macro for args { lset args 1 [sugar::expandScriptToken [lindex $args 1]] lset args 3 [sugar::expandScriptToken [lindex $args 3]] lset args 4 [sugar::expandScriptToken [lindex $args 4]] return $args } # That's still not perfect because messes with indentation. # Should use new scriptToList API to do it better. sugar::macro switch args { lappend result [lindex $args 0] set idx 0 set isquoted 0 while 1 { incr idx set arg [lindex $args $idx] if {$arg eq {--}} { lappend result $arg incr idx break } if {[string index $arg 0] ne {-}} break lappend result $arg } lappend result [lindex $args $idx] incr idx # Handle the two forms in two different ways if {[llength $args]-$idx == 1} { set l [lindex $args $idx 0] set isquoted 1 } else { set l [lrange $args $idx end] } # Expand scripts inside set temp {} foreach {pattern body} $l { if {$body ne {-}} { if {$isquoted} { set body [lindex [sugar::expandScriptToken [list $body]] 0] } else { set body [sugar::expandScriptToken $body] } } lappend temp $pattern $body } # Requote it if needed. if {$isquoted} { return [concat $result [list [list $temp]]] } else { return [concat $result $temp] } } ################################################################################ # Transformers included in sugar ################################################################################ ################ a macro for tail recursion ############## # TODO: give a name to this kind of macros, and maybe provide # a function to 'encapsulate' the common part of this # kind of macros involving the redefinition of proc. proc sugar::tailrecproc {name arglist body} { # Convert the script into a Tcl list set l [sugar::scriptToList $body] # Convert tail calls set l [sugar::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 sugar::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 [sugar::tailrec_convert_calls $name $arglist $scriptcode] lset code $lastidx $j 1 [list [sugar::listToScript $converted]] } } } } return $code } sugar/README0100644000175000017500000000103310030777176012777 0ustar antirezantirezSugar is a macro system for the Tcl programming language, with a design very similar to Lisp macros. Basically it provides a new way to create Tcl procedures, using the [sugar::proc] command instead of the normal Tcl [proc] command, and a way to define macros that are expanded inline when the procedure is created. For a quick API description check the API.txt file in this directory. For more information in a tutorial form check http://mini.net/tcl/sugar For some example, check the 'example' directory. Enjoy, Salvatore Sanfilippo sugar/API.txt0100644000175000017500000001157410031000130013246 0ustar antirezantirez-------------------------------------------------------------------------------- GENERAL INFORMATION -------------------------------------------------------------------------------- To require the sugar package, use: package require sugar -------------------------------------------------------------------------------- SUGAR MACRO API -------------------------------------------------------------------------------- sugar::proc name args body Creates a Tcl procedure exactly like [proc] does, but performs macro expansion in the body of the procedure just before to create it. sugar::macro name arglist body Define a command macro with the specified name. The macro body is called for every "macro usage", with the arguments of the usage. The macro must return a Tcl list with every element representing an argument of the code to expand in place of the macro usage. Example: sugar::macro first {macroname list} { list lindex $list 0 } The macro can have more than a name, like in the following example: sugar::macro {first second third} {macroname list} { set idx [lsearch -exact {first second third} $macroname] list lindex $list $idx } sugar::syntaxmacro name arglist body Define a syntax macro: a macro that is called regardless of it's name for every command in a procedure defined with sugar::proc. Syntax macros works like command macros defined with sugar::macro. For syntax macros, the arglist argument is often "args" because a syntax macro can't know the number of agruments in input in advance (being called for every command in the script). sugar::transformermacro name list body Define a transformer macro. The transformer macro is called for every element of the program the is belived a script (for example the second argument of the [while] command). The list argument is a Tcl list representing the script in an easy to parse form. Every element of the list is a list represeting a Tcl command of the original script. Every element of the command is a two-element list representing an element an element of the command in the original source code, where the first element represents the type of the token, and the second the actual value of the token. The following are the only token types defined: SPACE - A separator between arguments. A command may start with a space due to indentation. TOK - Every valid Tcl argument, including the command name. EOL - A command separator argument. May be ";" or a newline, or a mix between spaces, newlines, and ";". An example of script in list form is the following: {{{TOK puts} {SPACE { }} {TOK Hello} {EOL {;}}} {{TOK set} {SPACE { }} {TOK x} {SPACE { }} {TOK 10} {EOL {;}}}} A transformer macro should return a list of the same form that will be converted back to a Tcl script in source form by token concatenation. sugar::scriptToList script Lower-level API to turn a script into its list representation. sugar::listToScript list Lower-level API to turn a list representing a script into a script. sugar::expandScriptToken script Expand macros in the Tcl script 'script', and return it. Useful to write macros for commands with script as arguments, in order to perform macro expansion for they. sugar::expandExprToken expr Expand macros in the [expr] expression 'expr', and return it. Useful to write macros for commands with [expr] expressions as arguments, in order to perform macro expansion for they. sugar::currentProcName Return the fully-qualified name of the procedure currently processed by the macro system. Macros can call this function to know the name of the procedure in which the expansion is being performed. The following macro expands to a [put] call with the name of the procedure where it is used: sugar::macro PrintMyProc args { list puts [sugar::currentProcName] } sugar::currentProcTail Equivalent to [namespace tail [sugar::currentProcName]] sugar::currentProcNamespace Equivalent to [namespace qualifiers [sugar::currentProcName]] sugar::uniqueName Return a name guaranteed to be unique for every call. It's used to create non-colliding variable or procedure names for macro expansion. -------------------------------------------------------------------------------- READY TO USE MACROS PART OF SUGAR -------------------------------------------------------------------------------- sugar::tailrecproc name args body A wrapper to [proc] that converts tail recursive calls in iterations. The user should not use [return] to return the value of the tail call (Tcl will return the value of the last command executed, so [return] is useless in such a case, and tailrecproc will not be able to perform the conversion). Tailcalls are detected inside [if] branches at any depth. Currently tail calls inside [switch] are not processed, so the user should write the tail-recursive procedure using if/elseif/else. An usage example is inside the exaple directory, tailcall.tcl. sugar/AUTHORS0100644000175000017500000000005210031004010013132 0ustar antirezantirezSalvatore Sanfilippo