knit, by PYK, is another macro facility for Tcl
The full implementation is below.
knit is also available as ycl::knit::knit, along with unit tests.
knit uses tailcall to provide some of the features that were problematic in earlier macro systems. Each macro is a procedure that fills out a template according to the arguments it receives, and then tailcalls the template.
knit takes an EIAS approach to macros, meaning that it does not try to discern the structure of the template it is filling in, and instead focuses on providing the necessary substitutions that allow a macro author to choose how subtitutions are made. It turns out that just a small number answer most needs. The following three template substitutions are provided:
knead can be used to build a macro procedure specification without actually creating the macro procedure. knit is implemented as a trivial wrapper around knead. knead itself is useful for creating anonymous macros:
apply [knead x {expr {${x} * ${x}}}] 5
In contrast with Sugar, knit is more interleaved with the running interpreter, as Lisp macros are. Where Sugar attemps to parse a script and discern macros, knit inserts the macro code at runtime when the macro procedure is invoked. This makes knit a more natural fit with a Tcl script. Since knit macros are themselves procedures, knit eschews the issue that {*} raises for Sugar, and in general automatically has the features of a procedure that the merely-procedure-like macros in Sugar have to work hard for. One example is default arguments and another is $argv handling. The tradeoff is that knit incurs some cost during runtime that Sugar does not.
proc knit {name varnames body} { set cmdspec [uplevel [ list [namespace current]::knead $varnames $body]] uplevel [list proc $name {*}$cmdspec] } proc knead {varnames body} { variable knittemplate foreach varname $varnames { if {[llength $varname] > 1} { set varname [lindex $varname 0] } lappend mapparts [string map [list @varname@ [list $varname]] { \ \${@varname@} "\[lindex [list [set @varname@]]]" \ #{@varname@} [set @varname@] \ !{@varname@} "\[set [set @varname@]]" \ }] } set map \[list\ [join $mapparts { }]] set body [string map [list @map@ $map @template@ [ list $body]] $knittemplate] list $varnames $body } variable knittemplate { set body [string map @map@ @template@] tailcall try $body }
These examples show how the macros presented in Sugar, along with various other macros are implemented in knit
knit double x {expr {${x} * 2}} knit exp2 x {* ${x} * ${x}} knit charcount {x {char { }}} { regexp -all ***=${char} ${x} } knit clear arg1 {unset ${arg1}} knit first list {lindex ${list} 0} knit rest list {lrange ${list} 1 end} knit last list {lindex ${list} end} knit drop list {lrange ${list} 0 end-1} knit K {x y} { first [list ${x} ${y}] } knit yank varname { K [set ${varname}] [set ${varname} {}] } knit lremove {varname idx} { set ${varname} [lreplace [yank ${varname}] ${idx} ${idx}] } knit lpop listname { K [lindex [set ${listname}] end] [lremove ${listname} end] } knit lpop2 listname { K [lindex !{listname} end] [lremove ${listname} end] } foreach cmdname {* + - /} { knit $cmdname args " expr \[join \${args} [list $cmdname]] " } knit sete {varname exp} { set ${varname} [expr {#{exp}}] } knit greeting? x {expr {${x} in {hello hi}}} knit until {expr body} { while {!(#{expr})} ${body} } knit ?: {cond val1 val2} { if {#{cond}} {lindex ${val1}} else {lindex ${val2}} } knit finally {init finally do} { #{init} try ${do} finally ${finally} }