[NEM] ''6 Oct 2006'': While contemplating all things [OO] and [TIP] 257 [http://tip.tcl.tk/257], I came across an interesting interaction between features available in Tcl 8.5. It is possible to use [namespace ensemble] without needing any namespace to back it up! In particular, the -map option can be used to model simple slot-based objects. Together with the [apply] command, methods can then be added. To demonstrate, let's consider writing a simple stateless object to represent a rectangle on a canvas: ====== proc rect {canv x0 y0 x1 y1} { set id [$canv create rect $x0 $y0 $x1 $y1] namespace ensemble create -command $canv.rect$id \ -map [dict create id [list const $id] \ coords [list $canv coords $id]] } proc const val { return $val } ====== We now have a simple constructor that creates a rectangle on a canvas and creates an object command for that rectangle, with two ''slots'' to get the canvas id and coordinates associated with the rectangle: ====== pack [canvas .c] set r [rect .c 20 20 100 100] puts "id = [$r id], coords = [$r coords]" ====== These slots are just entries in the -map of the ensemble that alias to the "const" command to simply return their value. Note that ''no namespace is involved at all!'' ([DKF]: Actually, the namespace involved is the global namespace, but getting rid of that is equivalent to deleting the interpreter. [NEM]: Right, but it's not actually used for anything?) We can write a general method for creating slot aliases on these objects: ====== proc alias {object slot = command args} { set map [namespace ensemble configure $object -map] dict set map $slot [linsert $args 0 $command] namespace ensemble configure $object -map $map } ====== We can now add extra slots to the rectangle object: ====== alias $r type = const "rectangle" puts "$r is a [$r type]" ====== Using anonymous functions via [apply] in 8.5, we can even add new methods to the object. These are simply aliases to an anonymous function. We add a "self" parameter and arrange for it to be filled with the object command: ====== proc method {object name params body} { set params [linsert $params 0 self] alias $object $name = ::apply [list $params $body ::] $object } method $r width {} { lassign [$self coords] x0 y0 x1 y1 expr {abs($x1-$x0)} } method $r height {} { lassign [$self coords] x0 y0 x1 y1 expr {abs($y1-$y0)} } ====== We can even add method and alias as methods on the object itself: ====== alias $r method = ::method $r alias $r alias = ::alias $r $r method area {} { expr {[$self width] * [$self height]} } puts "area = [$r area]" ====== We could add mutable slots by creating a slot alias that can rewrite itself. This seems to be a fascinating new way of creating relatively ''lightweight'' objects, benefiting from the fast [namespace ensemble] mechanism, without having the overhead of an actual namespace. ---- [RS] proposes to call such "namespace ensemble objects" just "[neo]" :^) Also, in the chat we brain-stormed a bit more. Here's some sugar for neo creation: proc create {name map} {namespace ensemble create -command $name -map $map} The ''rect'' example then becomes ====== proc rect {canv x0 y0 x1 y1} { set id [$canv create rect $x0 $y0 $x1 $y1] create $canv.rect$id [dict create \ id [list const $id] \ coords [list $canv coords $id]] } ====== Introspection goes with ''namespace ensemble configure'': ====== % namespace ensemble configure ::.c.rect1 -map {width {::apply {self { lassign [$self coords] x0 y0 x1 y1 expr {abs($x1-$x0)} } ::} ::.c.rect1} height {::apply {self { lassign [$self coords] x0 y0 x1 y1 expr {abs($y1-$y0)} } ::} ::.c.rect1} id {::const 1} coords {::.c coords 1} type {::const rectangle}} -namespace :: -prefixes 1 -subcommands {} -unknown {} ====== [NEM]: I've added a little sugar to the alias method, to separate name and definition more clearly. We can further sugar "create" into a cute little object constructor. ====== proc object {name _where_ args} { set map [dict create] foreach {slot = value} $args { dict set map $slot $value } namespace ensemble create -command $name -map $map } ====== Which allows to leave off the dict create. The original proc can then become: ====== proc rect {canv x0 y0 x1 y1} { set id [$canv create rect $x0 $y0 $x1 $y1] set obj [object $canv.rect$id where \ id = [list const $id] \ coords = [list $canv coords $id]] $obj alias canvas = const $canv } ====== (Using alias for one of the initial slots too, for variety). More nice introspection comes out of the box: ====== % $r wrong # args: should be "::neo::.c.rect1 subcommand ?argument ...?" % $r help unknown or ambiguous subcommand "help": must be coords, height, id, type, or width ====== ---- [RS] Nice - this is really getting to be something :^) One question, though - how would one get rid of an ensemble object? [namespace ensemble] indicates no way to withdraw a -command... [NEM] Hmmm... [[[rename] $obj {}]] ? ---- [WHD] For the record, Snit 2.0 uses [namespace ensemble] in precisely this way. And yes, you just rename the ensemble command to {} to get rid of it. [NEM] Umm... I see use of -map in Snit 2.0 to attach methods to instances, but I don't see any use of [apply] for the methods, which was kind of the point of this page -- the -map is used to store ''everything''. [DKF]: I suspect that [apply] is still a bit new for some folks. Myself, I just ''love'' the way these features are mixed together to make something cool! [WHD] Nope, it's not using [apply]; I was speaking of [Using namespace ensemble without a namespace]. ---- Two tiny systems based on this: [neo] and [eos] ---- [NEM] 2007-12-21: Some time later this idea still intrigues me and seems quite useable for lightweight object systems. I give here a version called ''neat'' that I just knocked up. It is a slight variation on the above to support things like mutable variables in a simple and convenient fashion: ====== # neat.tcl -- # # A very simple and neat object system using Tcl 8.5 features. See # http://wiki.tcl.tk/16975 for details. # # This software is placed in the public domain. # package require Tcl 8.5 package provide neat 1.0 namespace eval neat { namespace export {[a-z]*} namespace ensemble create variable ref variable refid 0 proc slot {object slot = command args} { set map [namespace ensemble configure $object -map] dict set map $slot [linsert $args 0 $command] namespace ensemble configure $object -map $map } proc method {object name params body} { set params [linsert $params 0 self] slot $object $name = ::apply [list $params $body ::] $object } proc resolve {name ns} { if {[string match ::* $name]} { return $name } if {$ns eq "::"} { return ::$name } else { return $ns\::$name } } proc object {name args} { set map [dict create] foreach {slot value} $args { dict set map [string range $slot 1 end] [ref $value] } set ns [uplevel 1 { namespace current }] set name [resolve $name $ns] namespace ensemble create -command $name -map $map # Add some convenience methods slot $name method = ::neat::method $name slot $name slot = ::neat::slot $name slot $name var = ::neat::var $name return $name } proc const val { return $val } proc var {object name = value} { slot $object $name = {*}[ref $value] } proc ref value { variable ref variable refid set name ref[incr refid] set ref($name) $value return [list ref: $name] } proc ref: {name args} { variable ref if {[llength $args] == 0} { return $ref($name) } eval [linsert $args 1 ref($name)] } # Sugar for setting a variable proc <- {var value} { uplevel 1 [list set $var $value] } } ====== And an example of its use: ====== proc test {} { neat object neil -name "Neil Madden" -age 27 puts "Name = [neil name] Age = [neil age]" neil method say msg { puts "[$self name] says '$msg'" } neil say "Hello, World!" neil method birthday {} { neil age incr } neil birthday neil say "I'm now [neil age] years old!" # Add another variable neil var colour = "blue" neil colour <- "red" neil say "My favourite colour is [neil colour]" } ====== You can actually use pretty much any mutating command with these variables, e.g. things like: ====== neil name set "Neil" neil name append " Madden" ====== Classes are easy to make too - they're just ordinary procs: ====== proc person {obj name age} { neat object $obj -name $name -age $age } ====== <> Object Orientation | Example