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 }