Showing posts with label Tcl. Show all posts
Showing posts with label Tcl. Show all posts

2017-12-18

Ruby-style accessors in TclOO

A way to get Ruby-style accessors in TclOO. Inspired by code on the Tcl Wiki by “anonymous”, improved by Nathan Coulter. This code has been posted to the Wiki as well.

Accessors let you declare instance variables and getter and/or setter methods for them at the same time. The attr_reader and attr_accessor commands declare one or more variables and also methods for them with the same name, which return the current value of the variable. The attr_writer and attr_accessor commands declare one or more variables and also methods for them with the same name with an appended =, which take a value argument and set the variable to that value. So attr_accessor foo bar  declares the variables foo and bar , the getter methods foo and bar , and the setter methods foo= and bar=

namespace eval oo::define {
    proc attr {access args} {
        set class [lindex [info level -1] 1]
        ::oo::define $class variable {*}$args
        if {"reader" in $access} {
            foreach name $args {
                ::oo::define $class method $name {} \
                    [format {set %s} $name]
            }
        }
        if {"writer" in $access} {
            foreach name $args {
                ::oo::define $class method $name= v \
                    [format {set %s $v} $name]
            }
        }
    }
     
    interp alias {} attr_reader {} ::oo::define::attr reader
    interp alias {} attr_writer {} ::oo::define::attr writer
    interp alias {} attr_accessor {} ::oo::define::attr {reader writer}
}

2017-12-17

Defining a callback in Tcl

I have posted this text on the Tcl wiki as well.

Tcl uses the callback protocol for everything from higher-order functions to event-driven programming. As with so many other things Tcl, callbacks are fairly straightforward. Still, some explanation can be useful.

What is a callback?

A callback is "executable code that is passed as an argument to other code, which is expected to call back (execute) the argument at a given time" ([1], [2]).

In some cases, as when a -command option is passed to lsort, the receiving command (see below) immediately executes the code (blocking, or synchronous, callback). More commonly, a callback is specified in an after, bind, trace, I/O handler, or widget -command option, etc, and called when appropriate (event-oriented, deferred, or asynchronous, callback). A deferred callback must be able to execute even if the context where it was defined has since been destroyed.

2016-08-22

The structure of water

This is a nice quote:
In my experience, the best programming languages for just writing programs are those which have "the structure of water" as a zen enthusiast I once knew explained it. They can be deformed infinitely, without stress, to fit the shape their environment requires.
So, yes, I really and truly do prefer a multiparadigm language with a reasonably small, general working vocabulary, that doesn't make design choices for me. I like languages where object-oriented and functional programming (and imperative, and stream-oriented, and data-directed, etc) are all Things You Can Do rather than being The Only Way The Language Works.

Looking back on my own programming career, I find that the languages I have liked best (Lisp, C, Tcl) are very much like this description. The languages I have tried and given up on (Perl, Java, Python, C++) are more or less the opposite (Perl and C++ were designed to fit any user, but grew to be unwieldy and demanding).

2015-09-03

Hello, world!

The classic first demonstration program.

pack [button .b -text "Hello, world!" -command exit]

In a Tcl/Tk shell such as wish, this program creates a window and places a plain, unstyled button on it. The text on the button is "Hello, world!" and when you click the button, the program exits.

If you just want to print the text inside the shell, try

puts "Hello, world!"

2015-09-01

Writing sequentially

The challenge is as follows.

1) Pick out code5, the second part of the last word on the last line of this data file:

line1 1 2 3 4 5 end-code1-line
line2 2 2 3 4 5 end-code2-line
line3 3 2 3 4 5 end-code3-line
line4 4 2 3 4 5 end-code4-line
line5 5 2 3 4 5 end-code5-line

2) Do so by executing commands written sequentially ("pipelining" the data from one command to the next).

What we need to do is to read the data from the file, remove ("trim") whitespace from the beginning and end of it, split it into lines, pick the last line, split it into words, pick the last word, split it at the dashes, choose the second element of it.

The most natural way to solve this in Tcl is something like

package require fileutil

set data [string trim [::fileutil::cat lines.txt]]
set line [lindex [split $data \n] end]
set word [lindex [split $line] end]
lindex [split $word -] 1

This is not written in sequential order. The first command to be executed on each line is the one in the innermost brackets, then the command in the enclosing set of brackets, and so on.

The same code in sequential order looks like this:

package require fileutil

set v lines.txt
set v [::fileutil::cat $v]
set v [string trim $v]
set v [split $v \n]
set v [lindex $v end]
set v [split $v]
set v [lindex $v end]
set v [split $v -]
lindex $v 1

This works, but this is Tcl. We can abstract away a lot of detail here.

One idea is to enumerate the commands to be applied to the data and execute them in a loop:

proc seq {v cmds} {
    foreach cmd $cmds {
        set v [{*}$cmd $v]
    }
    set v
}

seq lines.txt {::fileutil::cat {string trim}}

But that only works as far as the string trim. The next command, to split the lines, requires a second argument.

We can solve that by creating command aliases:

interp alias {} lines {} apply {v {split $v \n}}
interp alias {} words {} split
interp alias {} last {} apply {v {lindex $v end}}

One of those, words, is unnecessary since that invocation doesn't need any further argument. It makes the code a bit clearer, though.

The other aliases work by rewriting invocations: the invocation last {a b c} is rewritten as lindex {a b c} end and so on.

Now we can perform the processing as far as seq lines.txt {::fileutil::cat {string trim} lines last words last}. The last two commands could have been aliased the same way, but let's be a bit more creative. If we define the convention that a command that contains the character / has an attached argument, we can let our code do the same rewriting as the aliases do.

proc seq {v cmds} {
    foreach cmd $cmds {
        if {[string match */* $cmd]} {
            set cmd [list apply [list v [regsub / $cmd { $v }]]]
        }
        set v [{*}$cmd $v]
    }
    set v
}

The if looks a little busy, but it's actually quite straightforward. The condition is that if $cmd contains a slash character somewhere (the asterisks state that there may be, but doesn't have to be, characters before and after the slash). Then a regsub command replaces that slash with the text { $v }, i.e. space, dollar, v, space. The resulting string is wrapped in a list with the text v as first element, and then that is wrapped in a list with apply as first element. The result becomes the rewritten command: if we had lindex/end, we now have {apply {v {lindex $v end}}}, which can be executed by set v [{*}$cmd $v].

And we can finally write the procedure sequentially. Compare with the second program above.

seq lines.txt {
    ::fileutil::cat
    {string trim}
    lines
    last
    words
    last
    split/-
    lindex/1
}

2015-08-17

Ordered numeric sequences

I wrote an answer on Stackoverflow, but I think the question is going to go away soon, so I'll post an edited version of my answer here.

The question was about how to find out whether digits in a sequence were in ascending (increasing) order or in descending (decreasing order). The sequence 1 2 3 is in increasing order, and so is 11 5, but this order is non-strict, i.e. the same digit may appear more than once if there are no other digits in between.

One can use mathematical comparison operators to check whether sequences of digits are in order:

foreach n {12345 54321 35214} {
    set ns [split $n {}]
    if {[::tcl::mathop::<= {*}$ns]} {
        puts "$n is in ascending order"
    } elseif {[::tcl::mathop::>= {*}$ns]} {
        puts "$n is in descending order"
    } else {
        puts "$n is neither in ascending or descending order"
    }
}

The command ::tcl::mathop::<= (which also implements the <= operator in expr) can take an arbitrary number of values, preferably numeric, and returns 1 if those values are in non-strict ascending order. It can be called directly on some values:

::tcl::mathop::<= 1 2 3 4 5
# -> 1

If the values are in a list it needs to be expanded first:

set a {1 2 3 4 5}
# -> 1 2 3 4 5
::tcl::mathop::<= {*}$a
# -> 1

If the values are packed in a string it needs to be split into a list and then expanded:

set a 12345
# -> 12345
::tcl::mathop::<= {*}[split $a {}]
# -> 1

The call to <= can be made a little less cumbersome by adding its namespace to the places where the interpreter looks for commands:

namespace path ::tcl::mathop
<= 1 2 3 4 5

Documentation: foreachiflistmathopnamespaceputssetsplit{*}